|
发表于 2023-4-9 19:59
|
显示全部楼层
本楼为最佳答案
本帖最后由 zjdh 于 2023-4-9 20:01 编辑
宏稍作修改,清除了一些不必要的语句:
Sub 销售()
Sheet2.Range("A4:F965536").ClearContents
Dim d, d1, arr, k As Integer, n As Integer, str
Set d = CreateObject("scripting.dictionary")
Set d1 = CreateObject("scripting.dictionary")
arr = Sheet1.Range("A1").CurrentRegion '销售
T1 = Sheet2.[B2]
T2 = Sheet2.[D2]
For k = 2 To UBound(arr)
If arr(k, 5) >= T1 And arr(k, 5) <= T2 Then
str = arr(k, 7) & "@" & arr(k, 8)
d1(str) = d1(str) + -arr(k, 9) '销售件数
If Not d.exists(str) Then
d(str) = arr(k, 8) & "|" & -arr(k, 9) '规格/数量
Else
d(str) = d(str) & "、" & arr(k, 8) & "|" & -arr(k, 9)
End If
End If '原来放错位置啦
Next k
Erase arr
ReDim Preserve arr(1 To d1.Count, 1 To 3)
For k = 0 To d.Count - 1
str = Split(d.keys()(k), "@")
n = n + 1
arr(n, 1) = str(0)
arr(n, 2) = d(d.keys()(k)) '规格/数量
arr(n, 3) = d1(d1.keys()(k)) '数量
Next k
Sheet2.Range("A4").Resize(UBound(arr), 3) = arr
End Sub
|
|