|
|
Sub 统计()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim ar As Variant
Dim d As Object
Dim br()
Set d = CreateObject("scripting.dictionary")
With Sheets("sheet1")
r = .Cells(Rows.Count, 1).End(xlUp).Row
If r < 2 Then MsgBox "数据源为空！": End
.[a1].CurrentRegion.Sort .[e1], 1, , , , , , 1 '第一个数据，表示升序还是降序，2为升序，1为降序，第二个数据表示标题行数
ar = .Range("a1:f" & r)
End With
ReDim br(1 To UBound(ar), 1 To 100)
br(1, 1) = "月份"
br(2, 1) = "商品名称"
br(2, 2) = "规格"
k = 2: y = 2
For i = 2 To UBound(ar)
If Trim(ar(i, 1)) <> "" And Trim(ar(i, 2)) <> "" Then
zd = Trim(ar(i, 1)) & "|" & Trim(ar(i, 2))
t = d(zd)
If t = "" Then
k = k + 1
d(zd) = k
t = k
br(k, 1) = ar(i, 1)
br(k, 2) = ar(i, 2)
End If
If Trim(ar(i, 5)) <> "" And Trim(ar(i, 6)) <> "" Then
If IsDate(ar(i, 5)) Then
yf = Month(ar(i, 5))
zf = yf & "|" & Trim(ar(i, 6))
lh = d(zf)
If lh = "" Then
y = y + 1
d(zf) = y
lh = y
br(1, y) = yf
br(2, y) = ar(i, 6)
End If
br(t, lh) = br(t, lh) + Val(ar(i, 3))
End If
End If
End If
Next i
y = y + 1
br(1, y) = "总计"
For i = 3 To k
hj = 0
For j = 3 To y - 1
hj = hj + br(i, j)
Next j
br(i, y) = hj
Next i
k = k + 1
br(k, 1) = "合计"
For j = 3 To y - 1
br(k, j) = Application.Sum(Application.Index(br, 0, j)) - br(1, j)
Next j
With Sheets("汇总")
.UsedRange.Clear
.[a1].Resize(k, y) = br
.[a1].Resize(k, y).Borders.LineStyle = 1
For j = 3 To y - 1
For s = j + 1 To y - 1
If .Cells(1, j) = .Cells(1, s) Then
.Range(.Cells(1, j), .Cells(1, s)).Merge
End If
Next s
Next j
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2023-4-29 01:13
楼主
