|
追記させていただきます。
自分なりに切ったはったで記述したものです。
よろしくお願いいたします。
Sub 商品別集計()
Dim dKey As String
Dim c As Range
Dim dic As Object
Dim v As Variant
Dim i As Long
Dim j As Long
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("ソート")
For Each c In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
dKey = c.Value & vbTab & c.Offset(, 1).Value
dic(dKey) = dic(dKey) + c.Offset(, 2).Value
Next
End With
With Sheets("集計") '転記シート
v = .Range("A1").CurrentRegion.Value
For i = 2 To UBound(v, 1)
For j = 2 To UBound(v, 2)
dKey = v(1, j) & vbTab & v(i, 1)
v(i, j) = dic(dKey)
Next
Next
.Range("A1").CurrentRegion.Value = v
.Select
End With
Set dic = Nothing
End Sub
|
|