| 
    
     |  | ▼ドカ さん: 
 こんにちは。
 以下のコードが、はたしてドガさんんが望んでおられるようなコードかどうか
 はなはだ自信はありませんが・・・
 ところで、アップされたサンプルデータ、一方が、全角で4月、他方が半角で4月。
 このままでは、これはマッチしませんよ。
 
 Sub Sample()
 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("Sheet1")  '元シート
 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("Sheet2")  '転記シート
 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
 MsgBox "転記が終了しました"
 
 End Sub
 
 |  |