汇总2

分类汇总求多工作表分类汇总的VBA代码！！

Sub hz1() Dim i&, Myr&, x$, Arr Dim d, k, t Set d = CreateObject("Scripting。Dictionary") Application。 ScreenUpdating = False Sheet2。Activate [a6:c200]。ClearContents Myr = Sheet1。[ak65536]。 End(xlUp)。Row Arr = Sheet1。Range("ak2:ap" & Myr) For i = 1 To UBound(Arr) If Arr(i, 4) <> "" Then x = A...全部

   Sub hz1() Dim i&, Myr&, x$, Arr Dim d, k, t Set d = CreateObject("Scripting。Dictionary") Application。
  ScreenUpdating = False Sheet2。Activate [a6:c200]。ClearContents Myr = Sheet1。[ak65536]。
  End(xlUp)。Row Arr = Sheet1。Range("ak2:ap" & Myr) For i = 1 To UBound(Arr) If Arr(i, 4) <> "" Then x = Arr(i, 4) & "," & Arr(i, 5) d(x) = d(x) + Arr(i, 6) End If Next k = ys t = ems [a6]。
  Resize(d。Count) = Application。Transpose(k) [c6]。Resize(d。Count) = Application。Transpose(t) Application。
  DisplayAlerts = False [a6]。Resize(d。Count)。TextToColumns Destination:=[a6], Comma:=True Application。
  DisplayAlerts = True Application。ScreenUpdating = True End Sub Sub hz2() Dim i&, Myr&, x$, Arr Dim d, k, t Set d = CreateObject("Scripting。
  Dictionary") Application。ScreenUpdating = False Sheet3。Activate [a6:c200]。ClearContents Myr = Sheet1。
  [ak65536]。End(xlUp)。Row Arr = Sheet1。Range("ak2:ap" & Myr) For i = 1 To UBound(Arr) If Arr(i, 3) <> "" Then x = Arr(i, 3) & "," & Arr(i, 4) & "," & Arr(i, 5) d(x) = d(x) + Arr(i, 6) End If Next k = ys t = ems [a6]。
  Resize(d。Count) = Application。Transpose(k) [d6]。Resize(d。Count) = Application。Transpose(t) Application。
  DisplayAlerts = False [a6]。Resize(d。Count)。TextToColumns Destination:=[a6], Comma:=True Application。
  DisplayAlerts = True Application。ScreenUpdating = True End Sub。收起