|
这样试试
Dim arr, brr, crr()
Set dic = CreateObject("scripting.dictionary")
'With '.Activate
arr = Sheets("销售明细").Range("A1").CurrentRegion
ReDim crr(1 To UBound(arr) + 500, 1 To 9)
For i = 2 To UBound(arr)
dw = arr(i, 1)
If dic.exists(dw) Then
dic(dw) = dic(dw) & "," & i
Else
dic(dw) = i
End If
Next
For Each k In dic.keys
brr = Split(dic(k), ",")
For i = 0 To UBound(brr)
m = m + 1
For j = 1 To 9
crr(m, j) = arr(brr(i), j)
' crr(m, 2) = arr(brr(i), 2)
' crr(m, 3) = arr(brr(i), 3)
' crr(m, 4) = arr(brr(i), 4)
' crr(m, 5) = arr(brr(i), 5)
' crr(m, 6) = arr(brr(i), 6)
' crr(m, 7) = arr(brr(i), 7)
' crr(m, 8) = arr(brr(i), 8)
'crr(m, 9) = arr(brr(i), 9)
Next
xj = xj + Val(crr(m, 9))
Next
crr(m + 1, 8) = "小计"
crr(m + 1, 9) = xj
hj = hj + xj
m = m + 2
xj = 0
Next
crr(m + 1, 8) = "合计"
crr(m + 1, 9) = hj
Application.DisplayAlerts = False
'For Each sht In Worksheets
'If sht.Name = "销售汇总" Then
' sht.Delete
'End If
'Next
zr = Split("日期 店名 编号 产品名称 销售类别 数量 单价 单价合计 销售金额")
Application.DisplayAlerts = True
' Sheets.Add.Name = "销售汇总"
' Sheets("销售汇总").[A1].Resize(1, 9) = zr
Sheets("销售分类").[A2].Resize(UBound(crr), UBound(crr, 2)) = crr
End Sub |
|