Option Explicit
Sub test()
Dim i&, j&, arr, s, k, m, col, t, brr, d As Object
Set d = CreateObject("Scripting.Dictionary")
'ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count)'第一次运行时用
'Sheets(2).Name = "汇总"
arr = Sheets(1).Range("a1:k19")
For i = 2 To UBound(arr)
s = arr(i, 3) & arr(i, 9)
If d.exists(s) Then
arr(d(s), 11) = arr(d(s), 11) + arr(i, 8)
Else
k = k + 1: d(s) = k
For j = 1 To 11
arr(k, j) = arr(i, j)
If j = 11 Then arr(k, j) = arr(i, 8)
Next
End If
Next
With Sheets("汇总")
.Range("a1").Resize(1, 11) = Array("序号", "类型", "商品名称", "仓库", "批号", "厂家", "单位", "库存数量", "进价", "售价", "累计库存数量")
.[a2].Resize(Rows.Count - 1, 11).ClearContents
.[a2].Resize(k, 11) = arr
ReDim brr(1 To k, 1 To 1)
For i = 1 To UBound(brr)
brr(i, 1) = i
Next
.[a2].Resize(UBound(brr), 1) = brr
End With
End Sub
|