同类项汇总合并问题

2008lhr · 发表于 2023-2-1 11:07

请各位老师、高手指导。
报表目的：将SHEET1基础数据汇总并显示在SHEET3中。但我写的“宏”只能完成前六个工人的产成品汇总数，请教高手完善和执指教。谢谢！！！

cszws · 发表于 2023-2-1 11:43

看起来不错下来试试

shiruiqiang · 发表于 2023-2-1 12:10

本帖最后由 shiruiqiang 于 2023-2-1 12:36 编辑

如图，d.exists这里有计算，但是只有一个key的话，直接装入（2），但是装入的（3）=(2)是空的

ykcbf1100 · 发表于 2023-2-1 12:48

求余额代码写错了。

3190496160 · 发表于 2023-2-1 13:58

Sub 一键合并汇总()
Dim arr, k%, d
Dim br()
Set d = CreateObject("scripting.dictionary")
arr = Sheet1.Range("a1").CurrentRegion
ReDim br(1 To UBound(arr), 1 To 6)
m = 1
For j = 1 To UBound(arr, 2)
br(m, j) = arr(1, j)
Next j
br(m, 6) = "余额"
For k = 2 To UBound(arr)
If arr(k, 1) <> "" Then
      t = d(arr(k, 1))
      If t = "" Then
         m = m + 1
         d(arr(k, 1)) = m
         t = m
         br(m, 1) = arr(k, 1)
         br(m, 4) = arr(k, 4)
      End If
      If br(t, 2) = "" Then
         br(t, 2) = arr(k, 2)
      Else
         br(t, 2) = br(t, 2) & "," & arr(k, 2)
      End If
      br(t, 3) = br(t, 3) + arr(k, 3)
      br(t, 5) = br(t, 5) + arr(k, 5)
      br(t, 6) = br(t, 5) - br(t, 3)
End If
Next k
With Sheets("Sheet3")
.Select
.Range("a:L") = ""
.Range("a1").Resize(m, 6) = br
End With
End Sub

3190496160 · 发表于 2023-2-1 13:59

3190496160 · 发表于 2023-2-1 14:00

同类项合并计算 - 副本.rar (14.29 KB, 下载次数: 7)

2008lhr · 发表于 2023-2-1 14:21

谢谢各位老师，辛苦了。我学习了。

2008lhr · 发表于 2023-2-2 15:10

我改了表，那位老师帮我完善一下，我会送花的，谢谢！！！

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

[求助] 同类项汇总合并问题

评分