|
▼マリモ さん:
こんにちは。たとえば。
Sub Sample()
Dim c As Range
Dim v() As Variant
Dim dkey As String
Dim dic As Object
Dim x As Long
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("Sheet2")
For Each c In .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
dkey = c.Value & vbTab & c.Offset(, 1).Value
dic(dkey) = dic.Count + 1 '1からの連番
Next
End With
ReDim v(1 To dic.Count, 1 To 3)
With Sheets("Sheet1")
For Each c In .Range("B2", .Range("B" & .Rows.Count).End(xlUp))
dkey = c.Value & vbTab & c.Offset(, 1).Value
If dic.exists(dkey) Then 'Sheet2に記載あれば
x = dic(dkey)
v(x, 1) = v(x, 1) + c.Offset(, 2).Value '通数足しこみ
v(x, 2) = c.Offset(, 3).Value '単価
'金額計算をしたものを足しこみ
v(x, 3) = v(x, 3) + c.Offset(, 2).Value * c.Offset(, 3).Value
End If
Next
End With
With Sheets("Sheet2")
.Range("C2").Resize(UBound(v, 1), UBound(v, 2)).Value = v
.Select
End With
MsgBox "処理完了"
End Sub
|
|