|    | 
     ▼ドカ さん: 
 
こんにちは。 
以下のコードが、はたしてドガさんんが望んでおられるようなコードかどうか 
はなはだ自信はありませんが・・・ 
ところで、アップされたサンプルデータ、一方が、全角で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 
 | 
     
    
   |