根据固定模板按月汇总订单、生产、发货统计表

哎哟哥哥 · 发表于 2023-2-11 23:00

领导要求根据固定模板按月汇总订单、生产、发货统计表，求助大神完善代码，我只会函数公式版本，但去重汇总等很慢，自己在论坛看了些帖子，修改了些代码，只会处理在一个月份，没法按月分开，求助大神修改，谢谢！

注:销售订单要根据（订货单位+产品名称+功率）3个条件汇总
生产要根据（产品名称+功率）2个条件汇总
发货要根据（产品名称+功率）2个条件汇总

3190496160 · 发表于 2023-2-12 10:03

这个问题，其实非常繁琐，先留个记号吧

jinlei2006 · 发表于 2023-2-12 10:09

sub uu（）
debug.print "for 循环，复制，粘贴，想快就用数组"
end sub

复制代码

jinlei2006 · 发表于 2023-2-12 10:15

jinlei2006 发表于 2023-2-12 10:09

推荐你用ACCESS数据库，符合你的需求

3190496160 · 发表于 2023-2-12 10:36

Sub 汇总()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim d As Object, dc As Object
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
ar = Sheets("销售清单").Range("a1").CurrentRegion
cr = Sheets("发货清单").Range("a1").CurrentRegion
br = Sheets("生产清单").Range("a1").CurrentRegion
For Each sh In Sheets
If sh.Index > 1 Then
      arr = sh.Range("a1").CurrentRegion
      For i = 2 To UBound(arr)
         If Trim(arr(i, 2)) <> "" Then
            If IsDate(arr(i, 2)) Then
                  yf = Month(arr(i, 2))
                  d(yf) = ""
            End If
         End If
      Next i
End If
Next sh
With Sheets("汇总")
.UsedRange.Offset(3).Clear
For Each k In d.keys
      k_1 = 0: k_2 = 0: k_3 = 0
      h = h + 1
      ReDim ar_1(1 To UBound(ar), 1 To 6)
      ReDim br_1(1 To UBound(br), 1 To 4)
      ReDim cr_1(1 To UBound(cr), 1 To 3)
      For i = 2 To UBound(ar)
         If Trim(ar(i, 2)) <> "" Then
            If IsDate(ar(i, 2)) Then
                  yf = Month(ar(i, 2))
                  If yf = k Then
                     zd = Trim(ar(i, 4)) & "|" & Trim(ar(i, 5)) & "|" & Trim(ar(i, 16))
                     t = dc(zd)
                     If t = "" Then
                        k_1 = k_1 + 1
                        dc(zd) = k_1
                        t = k_1
                        ar_1(k_1, 1) = k
                        ar_1(k_1, 2) = ar(i, 4)
                        ar_1(k_1, 3) = ar(i, 5)
                        ar_1(k_1, 4) = ar(i, 16)
                     End If
                     ar_1(t, 5) = ar_1(t, 5) + ar(i, 7)
                     ar_1(t, 6) = ar_1(t, 6) + ar(i, 10)
                  End If
            End If
         End If
      Next i
      dc.RemoveAll
      For i = 2 To UBound(br)
         If Trim(br(i, 2)) <> "" Then
            If IsDate(br(i, 2)) Then
                  yf = Month(br(i, 2))
                  If yf = k Then
                     zd = Trim(br(i, 4)) & "|" & Trim(br(i, 9))
                     t = dc(zd)
                     If t = "" Then
                        k_2 = k_2 + 1
                        dc(zd) = k_2
                        t = k_2
                        br_1(k_2, 1) = br(i, 4)
                        br_1(k_2, 2) = br(i, 9)
                     End If
                     br_1(t, 3) = br_1(t, 3) + br(i, 7)
                     br_1(t, 4) = br_1(t, 4) + br(i, 14)
                  End If
            End If
         End If
      Next i
      dc.RemoveAll
      For i = 2 To UBound(cr)
         If Trim(cr(i, 2)) <> "" Then
            If IsDate(cr(i, 2)) Then
                  yf = Month(cr(i, 2))
                  If yf = k Then
                     zd = Trim(cr(i, 8)) & "|" & Trim(cr(i, 12))
                     t = dc(zd)
                     If t = "" Then
                        k_3 = k_3 + 1
                        dc(zd) = k_3
                        t = k_3
                        cr_1(k_3, 1) = cr(i, 8)
                        cr_1(k_3, 2) = cr(i, 12)
                     End If
                     cr_1(t, 3) = cr_1(t, 3) + cr(i, 10)
                  End If
            End If
         End If
      Next i
      dc.RemoveAll
      If h = 1 Then
         If k_1 <> "" Then
            .Cells(4, 1).Resize(k_1, UBound(ar_1, 2)) = ar_1
         End If
         If k_2 <> "" Then
            .Cells(4, 7).Resize(k_2, UBound(br_1, 2)) = br_1
         End If
         If k_3 <> "" Then
            .Cells(4, 11).Resize(k_3, UBound(cr_1, 2)) = cr_1
         End If
         ws = .UsedRange.Rows.Count + 1
         .Cells(ws, 1) = k & "月累计（台数/总价）"
         .Range("a4:m" & ws).Borders.LineStyle = 1
      ElseIf h > 1 Then
         ws = .UsedRange.Rows.Count + 2
         .Rows("2:3").Copy .Cells(ws, 1)
         If k_1 <> "" Then
            .Cells(ws + 2, 1).Resize(k_1, UBound(ar_1, 2)) = ar_1
         End If
         If k_2 <> "" Then
            .Cells(ws + 2, 7).Resize(k_2, UBound(br_1, 2)) = br_1
         End If
         If k_3 <> "" Then
            .Cells(ws + 2, 11).Resize(k_3, UBound(cr_1, 2)) = cr_1
         End If
         ms = .UsedRange.Rows.Count + 1
         .Cells(ms, 1) = k & "月累计（台数/总价）"
         .Range("a" & ws + 2 & ":m" & ms).Borders.LineStyle = 1
      End If
Next k
End With
Application.DisplayAlerts = True
Set d = Nothing
Set dc = Nothing
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160 · 发表于 2023-2-12 10:37

固定模板按月汇总.rar (37.73 KB, 下载次数: 13)

3190496160 · 发表于 2023-2-12 10:38

代码仅供参考，合并单元格和合计的问题没有写代码，可以完成，但是太繁琐

哎哟哥哥 · 发表于 2023-2-12 13:58

3190496160 发表于 2023-2-12 10:37

非常感谢！累计汇总行有点问题，我自己先琢磨一下。

哎哟哥哥 · 发表于 2023-2-12 14:00

3190496160 发表于 2023-2-12 10:38
代码仅供参考，合并单元格和合计的问题没有写代码，可以完成，但是太繁琐

已经解决95%问题了，太感谢了

3190496160 · 发表于 2023-2-12 14:42

哎哟哥哥发表于 2023-2-12 13:58
非常感谢！累计汇总行有点问题，我自己先琢磨一下。

累计汇总就没有写代码的

		自动登录	找回密码
密码			免费注册

[求助] 根据固定模板按月汇总订单、生产、发货统计表

评分

评分