VBA 字典法学习与例子
Sub 二列多行求和()
Dim arr1, dic, x, arr2(1 To 10, 1 To 2), m%, k% '定义变量
Set dic = CreateObject("Scripting.dictionary") '后期绑定引用字典
arr1 = Range("A1").CurrentRegion '把单元区域装到数组arr1
For x = 2 To UBound(arr1, 1) '循环数组arr1的行
ists(arr1(x, 1)) Then '判断数组元素arr1(x,1)在字典关键词里是否存在，
m = dic(arr1(x, 1)) '如果存在，把关键词arr1(x,1)的条目读出来，在原来的
'基础上累加，通过读取关键词arr1(x,1)的条目，到在数组arr2那一行上累加
arr2(m, 2) = arr2(m, 2) + arr1(x, 2) '在数组arr2第m行，第2列上累加
Else '如果关键词arr1(x,1)不存在，那么
k = k + 1 '计数
dic(arr1(x, 1)) = k '把数组arr1(x,1)装到字典dic里，条目装一个k,
'这个k的作用来给数组arr2中到存放那一行
arr2(k, 1) = arr1(x, 1) '把数组arr1里的第x行第1列装到数组arr2的第k行，第1列
arr2(k, 2) = arr1(x, 2) '把数组arr1里的第x行第2列装到数组arr2的第k行，第2列
End If
Next x
Range("E1:F" & Rows.Count) = "" '清空区域，用来存放新的数据
[E1:F1] = Array("产品名称", "数量") '填充表头
[E2].Resize(k, 2) = arr2 '把数组arr2读到单元格区域
End Sub
2020-8-31
Sub 多列多行汇总()
Dim dic, arr1, x%, MySt, k%, arr2(1 To 15, 1 To 3), y%, m%
Set dic = CreateObject("Scripting.dictionary")
arr1 = Range("A1").CurrentRegion
For x = 2 To UBound(arr1, 1)
MySt = arr1(x, 1) & arr1(x, 2)
ists(MySt) Then
m = dic(MySt)
arr2(m, 3) = arr2(m, 3) + arr1(x, 3)
Else
k = k + 1
dic(MySt) = k
For y = 1 To 3
arr2(k, y) = arr1(x, y)
Next y
End If
Next x
Range("E1:G" & Rows.Count) = ""
[E1:G1] = Array("产品名称", "款号", "数量")
[E2].Resize(k, 3) = arr2
End Sub
产品名称
款号
数量
产品名称
款号
数量
WS-10
A
1
WS-10
A
100
WS-10
B
2
WS-10
B
2
WS-10
C
3
WS-10
C
3
VZ-45
A
1
VZ-45
A
1000
VZ-45
B
2
VZ-45
B
2
VZ-45
C
3
VZ-45
C
3
WS-10
A
99
VZ-45
A
999
Sub 删除重复数据－根据A列内容，保存表格内数据最上面一行，删除下面的重复行
Set d = CreateObject("scripting.dictionary")
Set Rng = Nothing
arr = [a1].CurrentRegion
Application.ScreenUpdating = False
For j = 1 To UBound(arr)
ists(arr(j, 1)) Then
If Rng Is Nothing Then
Set Rng = Cells(j, 1)
Else
Set Rng = Union(Rng, Cells(j, 1))
End If
Else
d(arr(j, 1)) = ""
End If
Next j
If Not Rng Is Nothing Then Rng.EntireRow.Delete
Application.ScreenUpdating = True
End Sub
客户姓名
月份
消费数量
A1
1
10
A2
1
10
A1
1
10
A2
1
10
A3
2
10
A4
2
10
A5
2
10
A3
2
10
A4
2
10
A5
2
10
A6
3
10
A7
3
10
A6
3
10
A7
3
10
A8
4
10
A4
4
10
A8
4
10
A4
4
10
A5
5
10
A6
5
10
A5
5
10
A6
5
10
A1
6
10
A10
6
10
A1
6
10
A10
6
10
vba自学好学吗
A8
7
10
A9
7
10
A8
7
10
A9
7
10
Sub 根据内容查询对应数据
Dim dic, arr1, arr2, arr3, arr4(1 To 100, 1 To 2), x& y& k& '定义变量
Set dic = CreateObject("Scripting.Dictionary") '后期绑定引用字典
Range("H2:I100") = "" '清空原有的数据
arr1 = Range("A1").CurrentRegion '把区域装到数组arr1
arr2 = Range("F1").CurrentRegion '把区域装到数组arr2
For x = 2 To UBound(arr1, 1) '循环数组arr1的行
dic(arr1(x, 1) & "|" & arr1(x, 2)) = arr1(x, 3) & "|" & arr1(x, 4)
'由于两个条件，而关键字只能装一个条件，所以用&把两件条件连起来，中间用"|"分开
'同理，由于有二个条目，而一个关键词只能对应一个条目，因此我也是用&连接起来，中间用"|"分开
'这样就解决了多行多列装入到字典，间接地突破了字典只能装两列
Next x
For y = 2 To UBound(arr2, 1) '循环数组arr2的行
arr3 = VBA.Split(dic(arr2(y, 1) & "|" & arr2(y, 2)), "|")
'根据arr2(y, 1) & "|" & arr2(y, 2)）读字典dic里的条目出来，其实它的条目就是我们
'刚才arr1后面两列的用"|"的数据，然后用函数Split切开，根据"|"，赋值给数组arr3
'大家一定要明白，Split通过"|"切开，赋值给数组arr3 数组arr3是一维数组，且它的上标从0开始
k = k + 1 '累加k
arr4(k, 1) = Val(arr3(0)) '把切开出来的数据放到数组arr4里
arr4(k, 2) = Val(arr3(1))
Next y
[H2].Resize(k, 2) = arr4
Sub 透视表示的汇总()
Dim arr1, dica, dicb, x& k& y& m& n& a& b& arr2() '定义相关的变量
Set dica = CreateObject("Scripting.Dictionary") '创建两个字典
Set dicb = CreateObject("Scripting.Dictionary")
arr1 = Range("A1").CurrentRegion '把区域装入数组arr1
For x = 2 To UBound(arr1, 1) '循环数组arr1的行
If ists(arr1(x, 2)) Then '如果关键字arr1(x,2)不存在，那么
'就把它装入字典dicb里，目的就是为了去重
k = k + 1 '累加k，目的给dicb做条目
dicb(arr1(x, 2)) = k + 1 '这里为什么还要加1呢？ 原因在数组arr2里第一列是产品名称
'第二放型号"大号"，第三列放型号"中号"，第四列放型号"小号"，第五列是行汇总
End If
Next x
ReDim arr2(1 To 100, 1 To dicb.Count + 2)
For y = 2 To UBound(arr1, 1)
ists(arr1(y, 1)) Then '如果字典dica里关键字arr1(y,1)存在，那么就累加arr2数据列
a = dica(arr1(y, 1)) '字典dica里关键词arr1(y,1)的条目读出来，目的在是在数组arr2
'里到累加数组arr2那一行，而数组arr2有五列，具体累加到那一列呢？

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。