[已解决]字典法按列标题汇总

hcy1185 · 发表于 2013-1-11 12:54

要求此处的列标题改动位置后,代码不需要修改

Book1.rar (6.39 KB, 下载次数: 30)

490540970 · 发表于 2013-1-11 13:55

学习了，又理解了一回字典

zjdh · 发表于 2013-1-11 14:24

不知你是要按班组汇总，还是按姓名汇总？？

E路人 · 发表于 2013-1-11 14:24

盲写一个
Sub test()
Dim i&, j&, x&, k, arr, arr1(), d As Object
Set d = CreateObject("Scripting.Dictionary")
arr = Range([A2], [D65536].End(3))
For i = 1 To UBound(arr, 1)
      If Not d.Exists(arr(i, 1)) Then
         d(arr(i, 1) & "|" & arr(i, 2)) = d.Count + 1
         k = d.keys
         ReDim Preserve arr1(1 To 4, 1 To d.Count)
         For x = 0 To d.Count - 1
            For j = 0 To 1
                  arr1(j + 1, d.Count) = Split(k(x), "|")(j)
            Next j
         Next x
      End If
Next i
For x = 1 To UBound(arr1, 2)
      For i = 1 To UBound(arr)
         If arr(i, 1) = arr1(1, x) And arr(i, 2) = arr1(2, x) Then
            arr1(3, x) = arr1(3, x) + arr(i, 4)
            arr1(4, x) = arr(i, 3)
         End If
      Next i
Next x
Range("H2:K65536").ClearContents
[H2].Resize(d.Count, 4) = Application.Transpose(arr1)
End Sub

hcy1185 · 发表于 2013-1-11 16:38

本帖最后由 hcy1185 于 2013-1-11 16:41 编辑

要求h1:k1处的列标题改动位置后,代码不需要修改
在1楼代码的基础上修改
按班组,姓名分类汇总

zjdh · 发表于 2013-1-12 09:15

本帖最后由 zjdh 于 2013-1-12 09:23 编辑

Sub 按列标题汇总()
Dim dTitle, arr, i&, dic, dic2, k, brr
arr = Sheet6.[a1].CurrentRegion
Set dTitle = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(arr, 2)
      dTitle(arr(1, i)) = i
Next
Set dic = CreateObject("Scripting.Dictionary")
Set dic2 = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(arr)
      BM = arr(i, dTitle("班组")) & "|" & arr(i, dTitle("姓名"))
      dic(BM) = dic(BM) + arr(i, dTitle(Cells(1, 9).Value))
      dic2(BM) = dic2(BM) + arr(i, dTitle(Cells(1, 10).Value))
Next
k = dic.keys
ReDim brr(1 To dic.Count, 1 To dTitle.Count)
For i = 1 To UBound(brr)
   brr(i, 1) = Split(k(i - 1), "|")(0)
   brr(i, 2) = Split(k(i - 1), "|")(1)
   brr(i, 3) = dic(k(i - 1))
   brr(i, 4) = dic2(k(i - 1))
Next
Range("G2:J65536").ClearContents
Range("G2").Resize(dic.Count, 4) = brr
End Sub

zjdh · 发表于 2013-1-12 09:30

按列标汇总.rar (10.18 KB, 下载次数: 153)

		自动登录	找回密码
密码			注册

[已解决]字典法按列标题汇总

评分

评分

评分

评分