|
|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
- Option Explicit
- Sub 汇总()
- Dim sht As Worksheet
- Dim dic As Object
- Dim arr(), Res()
- Dim i As Integer, k As Integer
- Dim dk As String
- Dim key
- Set dic = CreateObject("scripting.dictionary") '创建字典
- For Each sht In Sheets '遍历工作表
- ' str1 = sht.Name
- '如果工作表的名字不是【汇总】，遍历单元格，以【名称】为条目，【合计金额】为键值，加入字典
- If sht.Name <> "汇总" Then
- arr = sht.Range("a1").CurrentRegion
- For i = 2 To UBound(arr)
- dk = arr(i, 2)
- If Not dic.exists(dk) Then
- dic(dk) = arr(i, 3)
- Else
- dic(dk) = dic(dk) + arr(i, 3)
- End If
- Next
- End If
- Next
- ReDim Res(1 To dic.Count, 1 To 3) '定义res数组，以字典条目为行，列数为3列
- '遍历字典条目，把字典条目和键值赋值给数组res
- For Each key In dic.keys
- k = k + 1
- Res(k, 1) = k
- Res(k, 2) = key
- Res(k, 3) = dic(key)
- Next
- With Sheets("汇总")
- .Select
- .Range("a2:c" & .UsedRange.Rows.Count).ClearContents
- .Range("a2").Resize(UBound(Res), UBound(Res, 2)) = Res
-
- End With
- End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2021-3-26 13:45
楼主
很不错，学习了。