VBA汇总求助

天边2021 · 发表于 2024-10-19 14:10

图中为用函数汇总的效果，感觉效果不太智能，想用VBA代码来实现，有大神帮忙指点一下吗

小凡、、、 · 发表于 2024-10-19 14:50

本帖最后由小凡、、、于 2024-10-19 15:05 编辑

vba的话就基础的字典+数组，字典的基本运用

天边2021 · 发表于 2024-10-19 15:16

小凡、、、发表于 2024-10-19 14:50
vba的话就基础的字典+数组，字典的基本运用

谢谢

Qs18 · 发表于 2024-10-19 20:19

Sub qs() '2024/10/19
Dim arr, i, dic
Set dic = CreateObject("scripting.dictionary")
With Sheet2
arr = .Range("f8:l" & .Cells(Rows.Count, "g").End(3).Row)
For i = 1 To UBound(arr)
For j = 1 To UBound(arr, 2) - 1
s = s & "|" & arr(i, j)
Next
If Not dic.exists(s) Then
dic(s) = Application.Transpose(Application.Transpose(Application.Index(arr, i, 0)))
Else
a = dic(s)
a(6) = a(6) + arr(i, 6)
a(7) = a(7) + arr(i, 7)
dic(s) = a
End If
Next
.Range("P8").Resize(60000, 7) = ""
.Range("P8").Resize(dic.Count, UBound(arr, 2)) = Application.Rept(dic.items, 1)
ii = dic.items
End With
Set dic = Nothing
End Sub

复制代码

Qs18 · 发表于 2024-10-19 20:20

试试...........

Qs18 · 发表于 2024-10-19 20:21

试试...........

天边2021 · 发表于 2024-10-19 20:42

Qs18 发表于 2024-10-19 20:21
试试...........

这个结果没有去掉重复项啊？汇总只保留唯一值，然后汇总数量和重量就可以了

天边2021 · 发表于 2024-10-19 20:50

小凡、、、发表于 2024-10-19 14:50
vba的话就基础的字典+数组，字典的基本运用

这个代码数量和重量的计算结果不对，问题出在哪里呢？

Qs18 · 发表于 2024-10-19 21:15

Sub qs() '2024/10/19
Dim arr, i, dic
Set dic = CreateObject("scripting.dictionary")
With Sheet2
arr = .Range("f8:l" & .Cells(Rows.Count, "g").End(3).Row)
For i = 1 To UBound(arr)
s = arr(i, 1) & arr(i, 2) & arr(i, 3) & arr(i, 4) & arr(i, 5)
If Not dic.exists(s) Then
dic(s) = Application.Transpose(Application.Transpose(Application.Index(arr, i, 0)))
Else
a = dic(s)
a(6) = a(6) + arr(i, 6)
a(7) = a(7) + arr(i, 7)
dic(s) = a
End If
Next
.Range("P8").Resize(60000, 7) = ""
.Range("P8").Resize(dic.Count, UBound(arr, 2)) = Application.Rept(dic.items, 1)
End With
Set dic = Nothing
End Sub

复制代码

Qs18 · 发表于 2024-10-19 21:16

试试...........

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

[求助] VBA汇总求助