求助大佬，分类汇总还有按日期小计问题，万分感谢！

3190496160

有小计了
求助.rar (24.85 KB, 下载次数: 31)

2022-1-7 09:29 上传

点击文件名下载附件

CNS1993

小计+总计（练习--练习一下）。 求助.zip (23.53 KB, 下载次数: 6)

2022-6-6 16:30 上传

点击文件名下载附件

ykcbf1100

一键分类汇总

ykcbf1100

1. Sub ykcbf()   '//2025.3.14 排重汇总      全表自动生成
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     ReDim brr(1 To 10000, 1 To 100)
   
6.     bt = 1  '//标题行
   
7.     m = bt: n = 2
   
8.     On Error Resume Next
   
9.     With Sheets("源数据表")
   
10.         r = .Cells(Rows.Count, 1).End(3).Row
    
11.         arr = .[a1].Resize(r, 8)
    
12.     End With
    
13.     For j = 1 To 2
    
14.         brr(1, j) = arr(1, j)
    
15.     Next
    
16.     For i = bt + 1 To UBound(arr)
    
17.         s = arr(i, 1) & "|" & arr(i, 2)
    
18.         If Not d.exists(s) Then
    
19.             m = m + 1
    
20.             d(s) = m
    
21.             brr(m, 1) = arr(i, 1)
    
22.             brr(m, 2) = arr(i, 2)
    
23.         End If
    
24.         r = d(arr(i, 1) & "|" & arr(i, 2))
    
25.         s = arr(i, 3)
    
26.         If Not d.exists(s) Then
    
27.             n = n + 1
    
28.             d(s) = n
    
29.             brr(1, n) = s
    
30.         End If
    
31.         c = d(arr(i, 3))
    
32.         brr(r, c) = brr(r, c) + arr(i, 8)
    
33.     Next
    
34.     n = n + 1
    
35.     brr(1, n) = "合计"
    
36.     With Sheets("日报表")
    
37.         .UsedRange.Offset(1).Clear
    
38.         .Cells.Interior.ColorIndex = 0
    
39.         .[a2].Resize(1, n).Interior.Color = 49407
    
40.         With .[a2].Resize(m + 1, n)
    
41.             .Value = brr
    
42.             .Borders.LineStyle = 1
    
43.             .HorizontalAlignment = xlCenter
    
44.             .VerticalAlignment = xlCenter
    
45.             With .Font
    
46.                 .Name = "微软雅黑"
    
47.                 .Size = 11
    
48.             End With
    
49.         End With
    
50.         For i = 3 To m + 1
    
51.             .Cells(i, n) = Application.Sum(.Cells(i, 3).Resize(, n - 3))
    
52.         Next
    
53.         Call 小计
    
54.     End With
    
55.     Application.ScreenUpdating = True
    
56.     MsgBox "OK！"
    
57. End Sub

复制代码