遍历汇总

ddz79101

老师！有多个月表，需要汇总多个月表中的指定列在1张表中。请老师指点。谢谢

Yalishanda30

这种代码一搜一大把，改一改就能用

ddz79101

Yalishanda30 发表于 2024-9-19 15:33
这种代码一搜一大把，改一改就能用

老师！上行有合并单元格，试了几次没有成功

limonet

很好奇，你有很多类型各异的表，你是做哪块的？

ykcbf1100

全表自动生成，月份增减都不用改代码。

ykcbf1100

多表汇总

1. Sub ykcbf()   '//2024.9.19  排重汇总
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     Set sh = ThisWorkbook.Sheets("汇总")
   
6.     ReDim brr(1 To 10000, 1 To 100)
   
7.     m = 2: n = 1
   
8.     bt = [{"单位","个人","合计"}]
   
9.     brr(1, 1) = "姓名"
   
10.     On Error Resume Next
    
11.     For Each sht In Sheets
    
12.         If sht.Name <> sh.Name Then
    
13.             n = n + 3
    
14.             With sht
    
15.                 brr(1, n - 2) = .Name
    
16.                 arr = .UsedRange
    
17.                 For i = 3 To UBound(arr)
    
18.                     If Val(arr(i, 1)) Then
    
19.                         s = arr(i, 2)
    
20.                         If Not d.exists(s) Then
    
21.                             m = m + 1
    
22.                             d(s) = m
    
23.                             brr(m, 1) = s
    
24.                         End If
    
25.                         r = d(arr(i, 2))
    
26.                         brr(r, n - 2) = brr(r, n - 2) + arr(i, 8)
    
27.                         brr(r, n - 1) = brr(r, n - 1) + arr(i, 12)
    
28.                         brr(r, n) = brr(r, n) + arr(i, 13)
    
29.                     End If
    
30.                 Next
    
31.             End With
    
32.         End If
    
33.     Next
    
34.     n = n + 3
    
35.     brr(1, n - 2) = "合计"
    
36.     m = m + 1
    
37.     brr(m, 1) = "合计"
    
38.     With sh
    
39.         .UsedRange.Clear
    
40.         .Cells.Interior.ColorIndex = 0
    
41.         .[a1].Resize(2, n).Interior.Color = 49407
    
42.         .[a3].Resize(m - 2, 1).Interior.Color = 5296274
    
43.         With .[a1].Resize(m, n)
    
44.             .Value = brr
    
45.             .Borders.LineStyle = 1
    
46.             .HorizontalAlignment = xlCenter
    
47.             .VerticalAlignment = xlCenter
    
48.             With .Font
    
49.                 .Name = "微软雅黑"
    
50.                 .Size = 11
    
51.             End With
    
52.         End With
    
53.         For j = 2 To n Step 3
    
54.             .Cells(2, j).Resize(, 3) = bt
    
55.             .Cells(1, j).Resize(, 3).Merge
    
56.         Next
    
57.         For i = 3 To m - 1
    
58.             s1 = 0: s2 = 0: s3 = 0
    
59.             For j = 2 To n - 3
    
60.                 s1 = s1 + IIf(.Cells(2, j).Value = .Cells(2, n - 2).Value, .Cells(i, j).Value, 0)
    
61.                 s2 = s2 + IIf(.Cells(2, j).Value = .Cells(2, n - 1).Value, .Cells(i, j).Value, 0)
    
62.                 s3 = s3 + IIf(.Cells(2, j).Value = .Cells(2, n).Value, .Cells(i, j).Value, 0)
    
63.             Next
    
64.             .Cells(i, n - 2).Value = s1
    
65.             .Cells(i, n - 1).Value = s2
    
66.             .Cells(i, n).Value = s3
    
67.         Next
    
68.         .[a1].Resize(2).Merge
    
69.         For j = 2 To n
    
70.             .Cells(m, j).Value = Application.Sum(.Cells(3, j).Resize(m - 3))
    
71.         Next
    
72.     End With
    
73.     Application.ScreenUpdating = True
    
74.     MsgBox "OK！"
    
75. End Sub
    

复制代码

ddz79101

ykcbf1100 发表于 2024-9-19 16:24
全表自动生成，月份增减都不用改代码。

谢谢老师！完美成功

ddz79101

limonet 发表于 2024-9-19 16:23
很好奇，你有很多类型各异的表，你是做哪块的？

老师！我是统计管理类。末后岗。所以百搭，哈哈

ddz79101

ddz79101 发表于 2024-9-19 16:37
老师！我是统计管理类。末后岗。所以百搭，哈哈

急下班了吗！你表的勾稽关系不对。表中许多红点，你也发送了。

ykcbf1100

ddz79101 发表于 2024-9-19 16:37
老师！我是统计管理类。末后岗。所以百搭，哈哈

你的工作和我以前的工作很类似，我以前是做业务考核的。