|
|
Sub 统计销量()
Application.ScreenUpdating = False
Dim ar As Variant
Dim d As Object, dc As Object
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
With Sheets("原始数据")
r = .Cells(Rows.Count, 1).End(xlUp).Row
If r < 2 Then MsgBox "原始数据为空！": End
ar = .Range("a1:l" & r)
End With
With Sheets("统计表格")
.[a1].CurrentRegion.Offset(2).Borders.LineStyle = 0
.[a1].CurrentRegion.Offset(2) = Empty
h = UBound(ar)
br = .Range("a2:i" & h)
k = 1
For i = 2 To UBound(ar)
If Trim(ar(i, 5)) <> "" Then
t = d(Trim(ar(i, 5)))
If t = "" Then
k = k + 1
d(Trim(ar(i, 5))) = k
t = k
br(k, 1) = ar(i, 5)
End If
If br(t, 2) = "" Then
br(t, 2) = ar(i, 7)
Else
br(t, 2) = br(t, 2) & "," & ar(i, 7)
End If
rq = CDate(Format(ar(i, 9), "yyyy/m/d"))
For j = 3 To 9
sl = Val(br(1, j)) - 1
If rq >= Date - sl And rq <= Date Then
br(t, j) = br(t, j) + ar(i, 12)
End If
Next j
End If
Next i
For i = 1 To k
zf = "": dc.RemoveAll
rr = Split(br(i, 2), ",")
For s = 0 To UBound(rr)
If rr(s) <> "" Then
If Not dc.exists(rr(s)) Then
If zf = "" Then
zf = rr(s)
Else
zf = zf & "," & rr(s)
End If
dc(rr(s)) = ""
End If
End If
Next s
br(i, 2) = zf
Next i
.[a2].Resize(k, UBound(br, 2)) = br
.[a2].Resize(k, UBound(br, 2)).Borders.LineStyle = 1
End With
Set d = Nothing
Set dc = Nothing
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2023-1-9 17:50
楼主