VBA入门到进阶常用知识代码总结29

第29集 VBA数组与字典综合应用之下棋法
126、 多列汇总

Sub 多列汇总()
Dim brr(1 To 10000, 1 To 3)
Dim Brow
Dim arr, x, k
Dim d As New Dictionary
arr = Range(“a2:c” & Range(“a65536”).End(xlUp).Row)
For x = 1 To UBound(arr)
If d.Exists(arr(x, 1)) Then
Brow = d(arr(x, 1))
brr(Brow, 2) = brr(Brow, 2) + arr(x, 2)
brr(Brow, 3) = brr(Brow, 3) + arr(x, 3)
Else
k = k + 1
d(arr(x, 1)) = k
brr(k, 1) = arr(x, 1)
brr(k, 2) = arr(x, 2)
brr(k, 3) = arr(x, 3)
End If
Next x
Range(“f2”).Resize(k, 3) = brr
End Sub
127、 多条件多列汇总

Sub 多条件多列汇总()
Dim brr(1 To 10000, 1 To 4)
Dim Brow
Dim arr, x As Integer, sr As String, k As Integer
Dim d As New Dictionary
arr = Range(“a2:d” & Range(“a65536”).End(xlUp).Row)
For x = 1 To UBound(arr)
sr = arr(x, 1) & “-” & arr(x, 2)
If d.Exists(sr) Then
Brow = d(sr)
brr(Brow, 3) = brr(Brow, 3) + arr(x, 3)
brr(Brow, 4) = brr(Brow, 4) + arr(x, 4)
Else
k = k + 1
d(sr) = k
brr(k, 1) = arr(x, 1)
brr(k, 2) = arr(x, 2)
brr(k, 3) = arr(x, 3)
brr(k, 4) = arr(x, 4)
End If
Next x
Range(“g2”).Resize(k, 4) = brr
End Sub
128、 数据透视表式汇总

Sub 数据透视表式汇总()
Dim d As New Dictionary
Dim brr(1 To 10000, 1 To 7)
Dim Brow, Bcol
Dim arr, x, k
arr = Range(“a2:c” & Range(“a65536”).End(xlUp).Row)
For x = 1 To UBound(arr)
Bcol = (InStr(“1月2月3月4月5月6月”, arr(x, 2)) + 1) / 2 + 1
If d.Exists(arr(x, 1)) Then
Brow = d(arr(x, 1))
brr(Brow, Bcol) = brr(Brow, Bcol) + arr(x, 3)
Else
k = k + 1
d(arr(x, 1)) = k
brr(k, 1) = arr(x, 1)
brr(k, Bcol) = arr(x, 3)
End If
Next x
Range(“f2”).Resize(k, 7) = brr
End Sub