求助：Excel汇总明细表的数据到总表（类似筛选的功能）

发布网友发布时间：2023-10-10 13:10

共2个回答

热心网友时间：2024-12-15 03:04

Sub 汇总()
''你的原表在标题行上方先插入一行，也就是数据行从第3行起，
''把表头A2：i2复制到L2:T2，然后按ALT+F11打开VBA编辑器新插入一个模块，
''把这个代码复制进去，按F5运行.
''我做了个样表，你也可以参考下：
''链接: http://pan.baidu.com/s/1i5EE6Rr 密码: gz73
Dim brr(1 To 10000, 1 To 9)
Dim roww&
Dim arr, x%, sr$, k%
Dim d As Object
Set d = CreateObject("Scripting.Dictionary")
arr = Range("a3:i" & Range("b65536").End(xlUp).Row)
Range("l3:t" & Range("b65536").End(xlUp).Row).ClearContents
For x = 1 To UBound(arr)
    sr = arr(x, 1) & "-" & arr(x, 2) & "-" & arr(x, 3) & "-" & arr(x, 5)
    If d.Exists(sr) Then
      roww = d(sr)
      brr(roww, 4) = brr(roww, 4) + arr(x, 4)
      brr(roww, 6) = brr(roww, 6) + arr(x, 6)
      brr(roww, 7) = brr(roww, 7) + arr(x, 7)
      brr(roww, 8) = brr(roww, 8) & Chr(10) & Chr(13) & arr(x, 8)
      brr(roww, 9) = brr(roww, 9) + arr(x, 9)
    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)
      brr(k, 5) = arr(x, 5)
      brr(k, 6) = arr(x, 6)
      brr(k, 7) = arr(x, 7)
      brr(k, 8) = arr(x, 8)
      brr(k, 9) = arr(x, 9)
    End If
Next x
   Range("L3").Resize(k, 9) = brr
End Sub

热心网友时间：2024-12-15 03:05

能否把表格弄上来？这样看还挺费劲的。需要的发邮件chen043@sina.cn追问表格已发送··· 感谢···