楼主
kevinchengcw |
对于如上图一样的一份数据表，如何统计出各个工地领用的各个物料、单位及数量并生成各工地的统计清单会让人觉得有些麻烦，借用本例，此处演示一种利用VBA结合字典处理类似数据统计输出的一种方法，代码如下：
- Sub test()
- Dim Dic, Dic2, Arr, Tmp
- Dim M, N, I As Long
- Dim Str As String
- Set Dic = CreateObject("scripting.dictionary") '创建两个字典项目，用于记录及分类数据
- Set Dic2 = CreateObject("scripting.dictionary")
- '→→→→-
- '统计数据程序段
- '→→→→-
- With Worksheets("各工地汇总") '首先处理各工地汇总页面中的数据
- For M = 2 To .Cells(.Rows.Count, 1).End(3).Row '循环页面中的各行
- For N = 3 To .Cells(M, .Columns.Count).End(1).Column - 2 '根据数据特点，循环数据中需统计的各列
- If .Cells(M, N) <> "" Then '如果循环到的单元格不为空，则
- Str = .Cells(2, N).Value & vbTab & .Cells(M, 1).Value & vbTab & .Cells(M, 2).Value '将标题行及该行A，B列单元格依特定字符串接赋值给字符串（当作字典的key使用）
- If Not Dic.exists(Str) Then '先判断是否有该key存在，如果没有，则
- Dic.Add Str, .Cells(M, N).Value '添加该字典项，item项用于存储当前单元格的值
- Else '如果存在该字典项，则
- Dic(Str) = Dic(Str) + .Cells(M, N).Value '将现有item项与当前单元格值进行累加后作为新的item项赋值给字典对应项
- End If
- End If
- Next N '循环到下一列
- Next M '循环到下一行
- End With
- '→→→→→→→→→→--
- '将原始数据拆分成各自工地的程序段
- '→→→→→→→→→→--
- Arr = Dic.keys '将字典的所有key值赋值给数组Arr
- For N = LBound(Arr) To UBound(Arr) '循环数组中各项（用于提取字典对应各项）
- If Not Dic2.exists(Split(Arr(N), vbTab)(0)) Then Dic2.Add Split(Arr(N), vbTab)(0), "" '提取字典中的各个工地名（即字典key值依特定字符拆分后的每一段）并存储至字典2中
- '注：此处的工地名其实也可从表中直接读取
- Next N
- For N = LBound(Arr) To UBound(Arr) '再次循环数组各值，此次用来将各工地的物料及单件、数量等统计资料拆分后串接并存储为对应工地字典项的item项
- If Dic2(Split(Arr(N), vbTab)(0)) <> "" Then '如果对应的工地名的字典item项在字典2中不是空值，则将item项及新数据用“|”分隔串接后作为item项储存
- Dic2(Split(Arr(N), vbTab)(0)) = Dic2(Split(Arr(N), vbTab)(0)) & "|" & Split(Arr(N), vbTab)(1) & vbTab & Split(Arr(N), vbTab)(2) & vbTab & Dic(Arr(N))
- Else '如果不存在，则创建该工地的字典项，并将当前资料项依特定字符分隔串接后存为字典的item项
- Dic2(Split(Arr(N), vbTab)(0)) = Split(Arr(N), vbTab)(1) & vbTab & Split(Arr(N), vbTab)(2) & vbTab & Dic(Arr(N))
- '注意：上面这句等同于Dic2.Add Split(Arr(N), vbTab)(0), Split(Arr(N), vbTab)(1) & vbTab & Split(Arr(N), vbTab)(2) & vbTab & Dic(Arr(N))
- End If
- Next N
- '→→→→→→--
- '数据输出处理的程序段
- '→→→→→→--
- Arr = Dic2.keys '将字典2的key值全部赋值给数组Arr，便于循环取出各项值
- With Worksheets("sheet2") '将结果输出至sheet2工作表
- For N = LBound(Arr) To UBound(Arr) '循环数组各项
- If N = LBound(Arr) Then '如果是数组的第一个值（因第一次执行时如果用判断最后一行的方式会出现偏差，故单独执行首次）
- Tmp = Split(Dic2(Arr(N)), "|") '将当前数组项对应的字典2的item项依字符“|”分割后赋值给Tmp数组
- For M = LBound(Tmp) To UBound(Tmp) '分割后的数组项是由物料名，单位及数量组成，故要进一步分割放入对应单元格里
- .Cells(M + 1, 1) = Split(Tmp(M), vbTab)(0) '在这里单元格的递增可以与数组的递增同步（注意，数组在默认情况下下标从0开始）
- .Cells(M + 1, 2) = Split(Tmp(M), vbTab)(1)
- .Cells(M + 1, 3) = Split(Tmp(M), vbTab)(2)
- Next M
- Else '如果不是数组的第一个值，则
- I = .Cells(.Rows.Count, 1).End(3).Row '取得当前A列的最后一行的行标
- Tmp = Split(Dic2(Arr(N)), "|") '将当前数组项对应的字典2的item项依字符“|”分割后赋值给Tmp数组
- For M = LBound(Tmp) To UBound(Tmp) '从当前A列最后一行的下面隔一行起输出对应的项到对应的单元格
- .Cells(M + I + 2, 1) = Split(Tmp(M), vbTab)(0)
- .Cells(M + I + 2, 2) = Split(Tmp(M), vbTab)(1)
- .Cells(M + I + 2, 3) = Split(Tmp(M), vbTab)(2)
- Next M
- End If
- Next N
- .Cells.SpecialCells(xlCellTypeConstants, 23).Borders.LineStyle = 1 '执行完数据后输出后，将有数据的单元格的设置边框
- End With
- Set Dic = Nothing '清空字典项
- Set Dic2 = Nothing
-
- End Sub
以上代码对于物料名重复或工地名重复等情况处理效果良好。
附示例文件。（数据表：各工地汇总，结果输出表：Sheet2）
 复杂数据VBA统计方法示例.rar
|