求助如何用字典多表格汇总。

tcy119

如何用字典，按指定顺序多工作表汇总.rar (15.64 KB, 下载次数: 9)

2017-8-23 14:06 上传

点击文件名下载附件

姓名        基本工资        奖金额        伙食补助        加工工资
张三        500                        
李四        500                        
王五        500                        
赵六        300                        
钱七        200                        
刘九        200                        
对多表格用字典统计。

tcy119

Sub total()
    Application.ScreenUpdating = False
    Set d = CreateObject("Scripting.Dictionary")
    For Each sh In Sheets
        If sh.Name <> ActiveSheet.Name Then
            With sh
                r = .Cells(Rows.Count, 1).End(3).Row
                arr = .[a1].Resize(r, 2)
                For i = 2 To UBound(arr)
                    d(arr(i, 1)) = d(arr(i, 1)) + arr(i, 2)
                Next
            End With
        End If
    Next
    r = Cells(Rows.Count, 1).End(3).Row
    brr = [a2].Resize(r - 1, 2)
    For i = 1 To UBound(brr)
        If d.exists(brr(i, 1)) Then brr(i, 2) = d(brr(i, 1))
    Next
    [b2:b10000].ClearContents
    [a2].Resize(UBound(brr), UBound(brr, 2)) = brr
    Application.ScreenUpdating = True
End Sub

tcy119

这是代码，请高手帮一帮，谢谢！

tcy119

请高手帮一帮

tcy119

高手啊，快快出现，请帮帮，谢谢

jiangxiaoyun

1. Sub cd()
   
2.     Dim arr, brr(1 To 10000, 1 To 5)
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     For Each sht In Sheets
   
5.         If sht.Name <> ActiveSheet.Name Then
   
6.             arr = sht.[a1].CurrentRegion
   
7.             For i = 2 To UBound(arr)
   
8.                 If Not d.exists(arr(i, 1)) Then
   
9.                     k = k + 1
   
10.                     d(arr(i, 1)) = k
    
11.                     For j = 1 To 5
    
12.                         brr(k, j) = arr(i, j)
    
13.                     Next
    
14.                 Else
    
15.                     For n = 2 To 5
    
16.                         brr(d(arr(i, 1)), n) = brr(d(arr(i, 1)), n) + arr(i, n)
    
17.                     Next
    
18.                 End If
    
19.             Next
    
20.         End If
    
21.     Next
    
22.     [a2].Resize(k, 5) = brr
    
23. End Sub
    

复制代码

tcy119

等高手啊。

tcy119

jiangxiaoyun 发表于 2017-8-23 14:31

谢谢，能用了，最近在学习字典用法，字典确实不错。