| 
    
     |  | ▼ドカ さん: 
 Sample2を、さらに平易にしますと以下のようになります。
 
 Sub Sample3()
 Dim i As Long
 Dim x As Variant
 Dim y As Variant
 
 Sheets("Sheet2").Range("A1").CurrentRegion.Offset(1, 1).ClearContents  'ちょっと乱暴ですが
 i = 1
 Do While Sheets("Sheet1").Range("A" & i).Value <> ""
 x = Application.Match(Sheets("Sheet1").Range("A" & i).Value, Sheets("Sheet2").Rows(1), 0)
 If IsNumeric(x) Then
 y = Application.Match(Sheets("Sheet1").Range("B" & i).Value, Sheets("Sheet2").Columns(1), 0)
 If IsNumeric(y) Then
 Sheets("Sheet2").Cells(y, x).Value = Sheets("Sheet2").Cells(x, y).Value + Sheets("Sheet1").Range("C" & i).Value
 End If
 End If
 i = i + 1
 Loop
 
 MsgBox "転記が終了しました"
 
 End Sub
 
 |  |