Public rnTem As Range

Public stKehu As String
Public temDingdan As String

Public Const rowDingdan As Integer = 22

Public Sub ShengchengTongjiJine()
Application.ScreenUpdating = True
Application.DisplayAlerts = False
With tongji
    temRowTongji = .Cells(1048576, 5).End(xlUp).Row
    If temRowTongji > 1 Then .Range(.Cells(2, 2), .Cells(temRowTongji, 32)).Delete
End With
With mingxi
    temRowMingxi = .Cells(1048576, 2).End(xlUp).Row
    .Range(.Cells(2, 1), .Cells(temRowMingxi, 20)).Copy
    tongji.Cells(2, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End With
With tongji
    temRowTongji = .Cells(1048576, 5).End(xlUp).Row
    If temRowTongji > 1 Then
        .Range("S2:T" & temRowTongji).Delete Shift:=xlToLeft
        .Range("P2:P" & temRowTongji).Delete Shift:=xlToLeft
        .Range("L2:M" & temRowTongji).Delete Shift:=xlToLeft
        .Range("J2:J" & temRowTongji).Delete Shift:=xlToLeft
        .Range("E2:F" & temRowTongji).Delete Shift:=xlToLeft
'        .Range("E2:F" & temRowTongji).Delete Shift:=xlToLeft
        
'         If .AutoFilterMode = True Then
'            .Cells.AutoFilter
'        End If
'        .Range(.Cells(1, 2), .Cells(temRowTongji, 15)).AutoFilter
'        .AutoFilter.Sort.SortFields.Clear
'         .AutoFilter.Sort.SortFields.Add Key:=.Range(.Cells(2, 2), .Cells(temRowTongji, 2)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
'         .AutoFilter.Sort.SortFields.Add Key:=.Range(.Cells(2, 3), .Cells(temRowTongji, 3)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
'         .AutoFilter.Sort.SortFields.Add Key:=.Range(.Cells(2, 13), .Cells(temRowTongji, 13)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
'         With .AutoFilter.Sort
'             .Header = xlYes
'             .MatchCase = False
'             .Orientation = xlTopToBottom
'             .SortMethod = xlPinYin
'             .Apply
'         End With
         
        On Error Resume Next
        Set Rng = data.Range(data.Cells(2, 2), data.Cells(data.Cells(1000, 2).End(xlUp).Row, 1))
        Application.AddCustomList (Rng)
        On Error GoTo 0
        '增加一个自定义序列,该参数除了支持单元格对象，也支持数组。
        n = Application.CustomListCount
        .Select
        '自定义序列的数目
        .Range(.Cells(1, 2), .Cells(temRowTongji, 15)).Sort key1:=[b2], order1:=xlAscending, Header:=xlYes, ordercustom:=n + 1
        '使用自定义排序，ordercustom指定使用哪个自定义序列排序。
        '当使用自定义排序时，需要将OrderCustom参数设置为指定的序列在自定义列表中的顺序加1
        Application.DeleteCustomList n
         
        .Range(.Cells(2, 2), .Cells(temRowTongji, 14)).NumberFormatLocal = "G/通用格式"
        .Range(.Cells(2, 9), .Cells(temRowTongji, 10)).NumberFormatLocal = "￥#,##0.00;￥-#,##0.00"
        .Range(.Cells(2, 14), .Cells(temRowTongji, 14)).NumberFormatLocal = "￥#,##0.00;￥-#,##0.00"
        startMerge = 2
        For i = 3 To temRowTongji
            If .Cells(i, 2) = .Cells(i - 1, 2) Then
                
            Else
                If i - 1 > startMerge Then
                    .Rows(i).Insert
                    .Rows(i).Interior.Pattern = xlNone
                    i = i + 1
                    temRowTongji = temRowTongji + 1
                    startMerge = i
                Else
                    startMerge = i
                End If
            End If
        Next
        startMerge = 2
        For i = 2 To temRowTongji
            If .Cells(i, 3) = .Cells(i - 1, 3) And .Cells(i, 13) = .Cells(i - 1, 13) Then
                
            Else
                If i - 1 > startMerge Then
                    .Range(.Cells(startMerge, 13), .Cells(i - 1, 13)).Merge
    '                .Range(.Cells(startMerge, 11), .Cells(i - 1, 11)).Merge
                    startMerge = i
                Else
                    startMerge = i
                End If
            End If
        Next
        temSum = 0
        startMerge = 2
        For i = 3 To temRowTongji + 1
            temSum = temSum + .Cells(i - 1, 10)
            If .Cells(i, 3) = .Cells(i - 1, 3) Then
                
            Else
                If i - 1 > startMerge Then
                    .Range(.Cells(startMerge, 2), .Cells(i - 1, 2)).Merge
                    .Range(.Cells(startMerge, 3), .Cells(i - 1, 3)).Merge
                    .Range(.Cells(startMerge, 4), .Cells(i - 1, 4)).Merge
'                    .Range(.Cells(startMerge, 6), .Cells(i - 1, 6)).Merge
'                    .Range(.Cells(startMerge, 7), .Cells(i - 1, 7)).Merge
'                    .Range(.Cells(startMerge, 8), .Cells(i - 1, 8)).Merge
'                    .Range(.Cells(startMerge, 9), .Cells(i - 1, 9)).Merge
'                    .Range(.Cells(startMerge, 10), .Cells(i - 1, 10)).Merge
'                    .Range(.Cells(startMerge, 11), .Cells(i - 1, 11)).Merge
                    .Range(.Cells(startMerge, 14), .Cells(i - 1, 14)).Merge
                    .Cells(startMerge, 14) = temSum
                    temSum = 0
                    startMerge = i
                Else
                    If .Cells(startMerge, 5) <> "" Then .Cells(startMerge, 14) = temSum
                    temSum = 0
                    startMerge = i
                End If
            End If
        Next
    Call setFormatMingxi(.Range(.Cells(2, 2), .Cells(temRowTongji, 15)))

    End If
End With
End Sub


Sub shengchengWeishengchan()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With mingxi
    temRowMingxi = .Cells(1048576, 1).End(xlUp).Row
    temRowWeishengchan = weishengchan.Cells(1048576, 3).End(xlUp).Row
    If temRowWeishengchan > 1 Then weishengchan.Range(weishengchan.Cells(2, 1), weishengchan.Cells(temRowWeishengchan, 12)).Delete
    j = 2
    For i = 2 To temRowMingxi
        If .Cells(i, 17).Value > 0 Then
            
            Set rnTemp = data.Cells.Find(.Cells(i, 1).Value)
            If Not rnTemp Is Nothing Then
                weishengchan.Cells(j, 1).Value = data.Cells(rnTemp.Row, 1).Value
'                weichuhe.Range(weichuhe.Cells(j, 1), weichuhe.Cells(j, 14)).Interior.Color = rnTemp.Interior.Color
            Else
                weishengchan.Cells(j, 1).Value = .Cells(i, 1).Value
            End If
            
            weishengchan.Cells(j, 10).Value = .Cells(i, 2).Value
            weishengchan.Cells(j, 3) = .Cells(i, 6).Value
            If weishengchan.Range(weishengchan.Cells(j, 1), weishengchan.Cells(j, 2)).MergeCells = False Then
                weishengchan.Range(weishengchan.Cells(j, 1), weishengchan.Cells(j, 2)).Merge
            End If
            weishengchan.Cells(j, 4).Value = .Cells(i, 7).Value
            weishengchan.Cells(j, 5).Value = .Cells(i, 8).Value
            weishengchan.Cells(j, 6).Value = .Cells(i, 10).Value & .Cells(i, 9).Value
            weishengchan.Cells(j, 7).Value = .Cells(i, 12).Value
            weishengchan.Cells(j, 8).Value = .Cells(i, 3).Value
'            weishengchan.Cells(j, 9) = .Cells(i, 12)
'            weishengchan.Cells(j, 10) = .Cells(i, 17)
'            weishengchan.Cells(j, 11) = .Cells(i, 20)
            j = j + 1
        End If
    Next
End With
With weishengchan
    If .AutoFilterMode = True Then
        .Cells.AutoFilter
    End If
    .Range(.Cells(1, 1), .Cells(j - 1, 10)).AutoFilter
    .AutoFilter.Sort.SortFields.Clear
     .AutoFilter.Sort.SortFields.Add Key:=.Range(.Cells(2, 7), .Cells(j - 1, 7)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
     .AutoFilter.Sort.SortFields.Add Key:=.Range(.Cells(2, 1), .Cells(j - 1, 1)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
     .AutoFilter.Sort.SortFields.Add Key:=.Range(.Cells(2, 8), .Cells(j - 1, 8)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
     With .AutoFilter.Sort
         .Header = xlYes
         .MatchCase = False
         .Orientation = xlTopToBottom
         .SortMethod = xlPinYin
         .Apply
     End With
      startMerge = 2
    For i = 2 To j
        If .Cells(i, 7) = .Cells(i - 1, 7) And .Cells(i, 10) = .Cells(i - 1, 10) Then
            
        Else
            If i - 1 > startMerge Then
                .Range(.Cells(startMerge, 10), .Cells(i - 1, 10)).Merge
'                .Range(.Cells(startMerge, 11), .Cells(i - 1, 11)).Merge
                startMerge = i
            Else
                startMerge = i
            End If
        End If
    Next
     startMerge = 2
    For i = 2 To j
        If .Cells(i, 1) = .Cells(i - 1, 1) And .Cells(i, 7) = .Cells(i - 1, 7) And .Cells(i, 8) = .Cells(i - 1, 8) Then
            
        Else
            If i - 1 > startMerge Then
                .Range(.Cells(startMerge, 8), .Cells(i - 1, 8)).Merge
'                .Range(.Cells(startMerge, 11), .Cells(i - 1, 11)).Merge
                startMerge = i
            Else
                startMerge = i
            End If
        End If
    Next
    startMerge = 2
    For i = 2 To j
        If .Cells(i, 1) = .Cells(i - 1, 1) And .Cells(i, 7) = .Cells(i - 1, 7) Then
            
        Else
            If i - 1 > startMerge Then
                .Range(.Cells(startMerge, 7), .Cells(i - 1, 7)).Merge
'                .Range(.Cells(startMerge, 11), .Cells(i - 1, 11)).Merge
                startMerge = i
            Else
                startMerge = i
            End If
        End If
    Next
    startMerge = 2
    For i = 2 To j
        If .Cells(i, 1) = .Cells(i - 1, 1) Then
            
        Else
            If i - 1 > startMerge Then
                .Range(.Cells(startMerge, 1), .Cells(i - 1, 2)).Merge
'                .Range(.Cells(startMerge, 2), .Cells(i - 1, 2)).Merge
'                .Range(.Cells(startMerge, 3), .Cells(i - 1, 3)).Merge
'                .Range(.Cells(startMerge, 11), .Cells(i - 1, 11)).Merge
                startMerge = i
            Else
                startMerge = i
            End If
        End If
    Next
    .Select
    .Range(.Cells(1, 1), .Cells(j - 1, 10)).Select
    Selection.HorizontalAlignment = xlCenter
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
End With
weishengchan.Select
weishengchan.Cells(1, 1).Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Sub shengchengsuihuo(temDate, temDingdan)
'temDate = "2021.04.27"
'temDingdan = "5100049423"

Application.ScreenUpdating = False
With mingxi
    If UserForm1.LiJiasuihuodan.Value = True Then
        lijia.Range(lijia.Cells(5, 1), lijia.Cells(10, 12)).ClearContents
        lijia.Cells(15, 1) = "" '"备注:"
        lijia.Cells(13, 1) = "收货地址:"
        lijia.Cells(14, 1) = "收货人:"
        lijia.Cells(2, 10) = ""
    Else
        suihuo.Range(suihuo.Cells(4, 1), suihuo.Cells(18, 13)).ClearContents
        suihuo.Range(suihuo.Cells(1, 2), suihuo.Cells(1, 5)).ClearContents
        suihuo.Range(suihuo.Cells(1, 7), suihuo.Cells(1, 9)).ClearContents
'        suihuo.Range(suihuo.Cells(21, 1), suihuo.Cells(21, 13)).ClearContents
'        suihuo.Range(suihuo.Cells(22, 1), suihuo.Cells(22, 13)).ClearContents
        suihuo.Cells(1, 12) = ClearContents
        suihuo.Cells(23, 1) = "" '"备注:"
        suihuo.Cells(21, 1) = "收货地址:"
        suihuo.Cells(22, 1) = "收货人:"
        temRowsuihuo = suihuo.Cells(1048576, 1).End(xlUp).Row
        If temRowsuihuo > 25 Then suihuo.Rows("25:" & temRowsuihuo).Delete
    End If
    
    temRowMingxi = .Cells(1048576, 1).End(xlUp).Row
    temCount = 1
    temCountIn = 0
    temDianhua = ""
    temRen = ""
    For i = 2 To temRowMingxi
        If CStr(.Cells(i, 2)) = temDingdan And .Cells(i, 20) = temDate Then
            
            If UserForm1.LiJiasuihuodan.Value = True Then 'lijia customer
                
                If temCountIn = 0 Then
                    lijia.Cells(temCount + 1, 10) = temDingdan
                    lijia.Cells(temCount + 2, 12) = temDate
                    Set rnTem = yilan.Columns(2).Find(What:=.Cells(i, 1))
                    If Not rnTem Is Nothing Then
                        lijia.Cells(13, 1) = "收货地址:" & yilan.Cells(rnTem.Row, 25)
                        temDianhua = yilan.Cells(rnTem.Row, 27)
                        temRen = yilan.Cells(rnTem.Row, 26)
                        lijia.Cells(14, 1) = "收货人:" & temRen & "  电话:" & temDianhua
                        lijia.Cells(15, 1) = "备注:" & yilan.Cells(rnTem.Row, 29)
                    Else
                        MsgBox "在一览表中未找到客户信息"
                    End If
                End If
                If temCountIn > 5 Then
                    MsgBox "丽家目前最大允许6条，之后的条目不再读取。"
                    Exit For
                End If
                lijia.Cells(temCount + temCountIn + 4, 1) = temCountIn + 1
                lijia.Cells(temCount + temCountIn + 4, 2) = .Cells(i, 6)
                lijia.Cells(temCount + temCountIn + 4, 3) = .Cells(i, 5)
                lijia.Cells(temCount + temCountIn + 4, 4) = .Cells(i, 7)
'                lijia.Cells(temCount + temCountIn + 4, 5) = .Cells(i, 30)
                lijia.Cells(temCount + temCountIn + 4, 6) = .Cells(i, 29)
                lijia.Cells(temCount + temCountIn + 4, 7) = .Cells(i, 8)
                lijia.Cells(temCount + temCountIn + 4, 8) = .Cells(i, 13)
                lijia.Cells(temCount + temCountIn + 4, 9) = .Cells(i, 10)
                lijia.Cells(temCount + temCountIn + 4, 10) = .Cells(i, 14)
                lijia.Cells(temCount + temCountIn + 4, 11) = .Cells(i, 18)
                lijia.Cells(temCount + temCountIn + 4, 12) = .Cells(i, 21)
                temCountIn = temCountIn + 1
                If .Cells(i, 28) = "※" Then
                    temRowHuayan = huayan.Cells(1048576, 1).End(xlUp).Row
                    huayan.Cells(temRowHuayan + 1, 1) = .Cells(i, 20)
                    huayan.Cells(temRowHuayan + 1, 2) = .Cells(i, 6)
                    huayan.Cells(temRowHuayan + 1, 3) = .Cells(i, 7)
                    huayan.Cells(temRowHuayan + 1, 4) = .Cells(i, 10)
                    huayan.Cells(temRowHuayan + 1, 5) = .Cells(i, 18)
                    huayan.Cells(temRowHuayan + 1, 6) = .Cells(i, 1)
                    huayan.Cells(temRowHuayan + 1, 7) = lijia.Cells(13, 1)
                    huayan.Cells(temRowHuayan + 1, 8) = temRen
                    huayan.Cells(temRowHuayan + 1, 9) = temDianhua
                End If
                lijia.Select
                lijia.Cells(1, 1).Select
            Else 'no lijia customer
                
                suihuo.Cells(temCount + temCountIn + 3, 2) = .Cells(i, 27)
                .Range(.Cells(i, 5), .Cells(i, 7)).Copy
                suihuo.Cells(temCount + temCountIn + 3, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
                suihuo.Cells(temCount + temCountIn + 3, 6) = .Cells(i, 29)
                suihuo.Cells(temCount + temCountIn + 3, 7) = .Cells(i, 8)
                suihuo.Cells(temCount + temCountIn + 3, 8) = .Cells(i, 10)
                suihuo.Cells(temCount + temCountIn + 3, 9) = .Cells(i, 8) * .Cells(i, 30)
                suihuo.Cells(temCount + temCountIn + 3, 10) = .Cells(i, 8) * .Cells(i, 31)
                suihuo.Cells(temCount + temCountIn + 3, 11) = .Cells(i, 18)
                suihuo.Cells(temCount + temCountIn + 3, 12) = .Cells(i, 21)
                suihuo.Cells(temCount + temCountIn + 3, 13) = .Cells(i, 32)
                suihuo.Cells(temCount + temCountIn + 3, 1) = temCountIn + 1
                
                If temCountIn = 0 Then
                    suihuo.Cells(temCount, 7) = temDingdan
                    suihuo.Cells(temCount, 2) = .Cells(i, 1)
                    suihuo.Cells(temCount, 12) = temDate
                    Set rnTem = yilan.Columns(2).Find(What:=.Cells(i, 1))
                    If Not rnTem Is Nothing Then
'                        suihuo.Cells(temCount + 20, 3) = yilan.Cells(rnTem.Row, 25)
'                        suihuo.Cells(temCount + 21, 3) = yilan.Cells(rnTem.Row, 26)
'                        suihuo.Cells(temCount + 21, 4) = yilan.Cells(rnTem.Row, 27)
                        suihuo.Cells(temCount + 20, 1) = "收货地址:" & yilan.Cells(rnTem.Row, 25)
                        temDianhua = yilan.Cells(rnTem.Row, 27)
                        temRen = yilan.Cells(rnTem.Row, 26)
                        suihuo.Cells(temCount + 21, 1) = "收货人:" & temRen & "  电话:" & temDianhua
                        suihuo.Cells(temCount + 22, 1) = "备注:" & yilan.Cells(rnTem.Row, 29)
                    Else
                        MsgBox "在一览表中未找到客户信息"
                    End If
                End If
                If .Cells(i, 28) = "※" Then
                    temRowHuayan = huayan.Cells(1048576, 1).End(xlUp).Row
                    huayan.Cells(temRowHuayan + 1, 1) = .Cells(i, 20)
                    huayan.Cells(temRowHuayan + 1, 2) = .Cells(i, 6)
                    huayan.Cells(temRowHuayan + 1, 3) = .Cells(i, 7)
                    huayan.Cells(temRowHuayan + 1, 4) = .Cells(i, 10)
                    huayan.Cells(temRowHuayan + 1, 5) = .Cells(i, 18)
                    huayan.Cells(temRowHuayan + 1, 6) = .Cells(i, 1)
                    huayan.Cells(temRowHuayan + 1, 7) = suihuo.Cells(temCount + 20, 1)
                    huayan.Cells(temRowHuayan + 1, 8) = temRen
                    huayan.Cells(temRowHuayan + 1, 9) = temDianhua
                End If
                If temCountIn < 14 Then
                    temCountIn = temCountIn + 1
                Else
                    temCountIn = 0
                    temCount = temCount + 25
                    suihuo.Rows("1:25").Copy suihuo.Cells(temCount, 1)
                    suihuo.Range(suihuo.Cells(4, 1), suihuo.Cells(18, 13)).ClearContents
                    suihuo.Range(suihuo.Cells(1, 2), suihuo.Cells(1, 5)).ClearContents
                    suihuo.Range(suihuo.Cells(1, 7), suihuo.Cells(1, 9)).ClearContents
'                    suihuo.Range(suihuo.Cells(21, 3), suihuo.Cells(21, 12)).ClearContents
'                    suihuo.Cells(22, 3).ClearContents
'                    suihuo.Range(suihuo.Cells(22, 4), suihuo.Cells(22, 8)).ClearContents
'                    suihuo.Cells(1, 12) = ClearContents
                    suihuo.Cells(23, 1) = "" '"备注:"
                    suihuo.Cells(21, 1) = "收货地址:"
                    suihuo.Cells(22, 1) = "收货人(电话)：:"
                End If
                suihuo.Select
                suihuo.Cells(1, 1).Select
            End If
            
        End If
    Next
End With
Application.ScreenUpdating = True
End Sub

Sub shengchengchuku(temDate, temDingdan)
'temDate = "2021.04.23"
'temDingdan = "202104-SY-01"
Application.ScreenUpdating = False
With mingxi
    chuku.Range(chuku.Cells(4, 1), chuku.Cells(11, 8)).ClearContents
    chuku.Range(chuku.Cells(2, 3), chuku.Cells(2, 6)).ClearContents
    chuku.Cells(1, 8).ClearContents
    chuku.Cells(2, 8).ClearContents
    temRowchuku = chuku.Cells(1048576, 2).End(xlUp).Row
    If temRowchuku > 13 Then chuku.Rows("14:" & temRowchuku).Delete
    
    temRowMingxi = .Cells(1048576, 1).End(xlUp).Row
    temCount = 1
    temCountIn = 0
    For i = 2 To temRowMingxi
        If CStr(.Cells(i, 2)) = temDingdan And .Cells(i, 19) = temDate Then
            chuku.Cells(temCount, 8) = temDingdan
            chuku.Cells(temCount + 1, 3) = .Cells(i, 1)
            chuku.Cells(temCount + 1, 8) = temDate
            .Range(.Cells(i, 6), .Cells(i, 10)).Copy
            chuku.Cells(temCount + temCountIn + 3, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            .Range(.Cells(i, 13), .Cells(i, 14)).Copy
            chuku.Cells(temCount + temCountIn + 3, 7).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            chuku.Cells(temCount + temCountIn + 3, 1) = temCountIn + 1
            If temCountIn < 7 Then
                temCountIn = temCountIn + 1
            Else
                temCountIn = 0
                temCount = temCount + 13
                chuku.Rows("1:13").Copy chuku.Cells(temCount, 1)
                chuku.Range(chuku.Cells(temCount + 3, 2), chuku.Cells(temCount + 10, 8)).ClearContents
                chuku.Cells(temCount, 8).ClearContents
                chuku.Range(chuku.Cells(temCount + 1, 3), chuku.Cells(temCount + 1, 6)).ClearContents
                chuku.Cells(temCount + 1, 8).ClearContents
            End If
        End If
    Next
    chuku.Select
    chuku.Cells(1, 1).Select
End With
Application.ScreenUpdating = True
End Sub

Sub shengchengzhishipiao()
Application.ScreenUpdating = False
temDate = "2021.4.22"
temDingdan = "202104-SY-01"
With mingxi
    zhishi.Range(zhishi.Cells(4, 3), zhishi.Cells(6, 3)).ClearContents
    zhishi.Range(zhishi.Cells(4, 5), zhishi.Cells(6, 5)).ClearContents
    zhishi.Range(zhishi.Cells(4, 7), zhishi.Cells(6, 7)).ClearContents
    zhishi.Range(zhishi.Cells(3, 3), zhishi.Cells(3, 4)).ClearContents
    zhishi.Range(zhishi.Cells(3, 6), zhishi.Cells(3, 7)).ClearContents
    zhishi.Range(zhishi.Cells(7, 3), zhishi.Cells(7, 7)).ClearContents
    zhishi.Cells(8, 3).ClearContents
    zhishi.Cells(8, 4).ClearContents
    zhishi.Cells(8, 5).ClearContents
    temRowZhishi = zhishi.Cells(1048576, 2).End(xlUp).Row
    If temRowZhishi > 10 Then zhishi.Range(zhishi.Cells(9, 1), zhishi.Cells(temRowZhishi, 7)).Delete
    
    Set rnTem = .Columns(18).Find(What:=temDate)
    If Not rnTem Is Nothing Then
        temCount = 0
        temAdress = rnTem.Address
        Do
            zhishi.Rows(temCount * 10 + 1 & ":" & temCount * 10 + 10).Copy zhishi.Cells((temCount + 1) * 10 + 1, 1)
            temRowMingxi = rnTem.Row
            zhishi.Cells(temCount * 10 + 3, 3) = .Cells(temRowMingxi, 6)
            zhishi.Cells(temCount * 10 + 3, 6) = .Cells(temRowMingxi, 1)
            zhishi.Cells(temCount * 10 + 4, 3) = .Cells(temRowMingxi, 9)
'            zhishi.Cells(temCount * 10 + 5, 3) = .Cells(temRowMingxi, 7)
            zhishi.Cells(temCount * 10 + 6, 3) = .Cells(temRowMingxi, 18)
            
            
            zhishi.Cells(temCount * 10 + 7, 3) = "备注"
            zhishi.Cells(temCount * 10 + 8, 3) = temChupiao
'            zhishi.Cells(temCount * 10 + 4, 5) = Format(Date, "yyyy.mm.dd")
'            zhishi.Cells(temCount * 10 + 5, 5) = Format(Date, "yyyy.mm.dd")
            zhishi.Cells(temCount * 10 + 6, 5) = .Cells(temRowMingxi, 21)
            zhishi.Cells(temCount * 10 + 8, 5) = Format(Date, "yyyy.mm.dd")
            zhishi.Cells(temCount * 10 + 4, 7) = .Cells(temRowMingxi, 7)
'            zhishi.Cells(temCount * 10 + 5, 7) = .Cells(temRowMingxi, 11)
'            zhishi.Cells(temCount * 10 + 6, 7) = .Cells(temRowMingxi, 11)
            zhishi.Cells(temCount * 10 + 8, 7) = .Cells(temRowMingxi, 11)
            
            
            
            temCount = temCount + 1
            Set rnTem = .Columns(18).FindNext(after:=rnTem)
        Loop While Not rnTem Is Nothing And temAdress <> rnTem.Address
        
    End If
    
End With
Application.ScreenUpdating = True
End Sub

Sub copyToMingXi()
With dingdan
    temRowDingdan = .Cells(rowDingdan, 3).End(xlUp).Row
    If temRowDingdan > 2 Then
        temRowMingxi = mingxi.Cells(1048576, 1).End(xlUp).Row
        j = 1
        For i = 3 To temRowDingdan
            If .Cells(i, 7) <> "" Or .Cells(i, 5) <> "" Then
                If .Cells(i, 7) <> "" And .Cells(i, 12) <> "" Then
                    .Cells(i, 5) = Application.WorksheetFunction.RoundUp(.Cells(i, 7) / .Cells(i, 12), 0)
                Else
                    .Cells(i, 7) = Application.WorksheetFunction.RoundUp(.Cells(i, 5) * .Cells(i, 12), 0)
                End If
                mingxi.Cells(temRowMingxi + 1, 1) = .Cells(1, 2)
                mingxi.Cells(temRowMingxi + 1, 2) = .Cells(1, 5)
                mingxi.Cells(temRowMingxi + 1, 3) = .Cells(1, 11)
                .Range(.Cells(i, 2), .Cells(i, 12)).Copy mingxi.Cells(temRowMingxi + 1, 5)
                mingxi.Cells(temRowMingxi + 1, 22) = .Cells(i, 14)
                mingxi.Cells(temRowMingxi + 1, 27) = .Cells(i, 13)
                mingxi.Cells(temRowMingxi + 1, 4) = j
                .Range(.Cells(i, 15), .Cells(i, 19)).Copy mingxi.Cells(temRowMingxi + 1, 28)
                temRowMingxi = temRowMingxi + 1
                j = j + 1
            End If
        Next
    End If
End With
End Sub


Sub ShouzhuDingdan(temDingdan)
Application.ScreenUpdating = False
With dingdan
    .Range(.Cells(3, 2), .Cells(rowDingdan, 20)).ClearContents
    Set rnTem = yilan.Columns(2).Find(What:=temDingdan)
    If Not rnTem Is Nothing Then
        temRowDingdan = 3
        temAdress = rnTem.Address
        Do
            temRowYilan = rnTem.Row
            .Cells(temRowDingdan, 2) = yilan.Cells(temRowYilan, 5)
            .Cells(temRowDingdan, 3) = yilan.Cells(temRowYilan, 6)
            .Cells(temRowDingdan, 4) = yilan.Cells(temRowYilan, 7)
            .Cells(temRowDingdan, 6) = yilan.Cells(temRowYilan, 15)
            .Cells(temRowDingdan, 10) = yilan.Cells(temRowYilan, 17)
            .Cells(temRowDingdan, 12) = yilan.Cells(temRowYilan, 13)
            .Cells(temRowDingdan, 13) = yilan.Cells(temRowYilan, 4)
            .Cells(temRowDingdan, 14) = yilan.Cells(temRowYilan, 23)
            .Cells(temRowDingdan, 15) = yilan.Cells(temRowYilan, 24)
            .Cells(temRowDingdan, 16) = yilan.Cells(temRowYilan, 11)
            .Cells(temRowDingdan, 17) = yilan.Cells(temRowYilan, 20)
            .Cells(temRowDingdan, 18) = yilan.Cells(temRowYilan, 21)
            .Cells(temRowDingdan, 19) = yilan.Cells(temRowYilan, 28)
            temRowDingdan = temRowDingdan + 1
            Set rnTem = yilan.Columns(2).FindNext(after:=rnTem)
        Loop While Not rnTem Is Nothing And temAdress <> rnTem.Address
        .Range(.Cells(3, 11), .Cells(temRowDingdan - 1, 11)).FormulaR1C1 = "=RC[-1]*RC[-4]"
    Else
        MsgBox "未找到相关数据。"
    End If
End With
Application.ScreenUpdating = True
End Sub
'stKehu = kehu

Sub MenuShow()
On Error Resume Next
    UserForm1.Show 0
End Sub
Function dateFormat(temStr)
If IsDate(temStr) Then
    dateFormat = Format(temStr, "yyyy.mm.dd")
Else
    dateFormat = temStr
End If
End Function


Sub abc()
temDate = Date
If IsDate(temDate) Then
    MsgBox dateFormat(temDate)
Else
    MsgBox temDate
End If

Set wsDingdan = dingdan
Set wsYilan = yilan
Set wsMingxi = mingxi
Set wsZhishi = zhishi
Set wsChuku = chuku
Set wsChukuhou = chukuhou
Set wsSuihuo = suihuo
Set wsLijiaSuihuo = lijiasuihuo
Set wsHuayan = huayan
Set wsData = data
MsgBox Date
Debug.Print wsDingdan.Name, wsYilan.Name, wsMingxi.Name, wsZhishi.Name, wsData.Name

End Sub
Sub setFormatMingxi(temRn As Range)
    temRn.Parent.Select
    temRn.Select
    Selection.Font.Size = 11
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
End Sub