| 
    
     |  | ▼ドカ さん: 
 もし、ドガさんがシート関数のMATCHをよくご存知なら、効率は非常に悪くなりますが
 以下のコードのほうが、ドガさんにとっては、いいのかもしれません。
 
 Sub Sample2()
 Dim i As Long
 Dim x As Variant
 Dim y As Variant
 
 With 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, .Rows(1), 0)
 If IsNumeric(x) Then
 y = Application.Match(Sheets("Sheet1").Range("B" & i).Value, .Columns(1), 0)
 If IsNumeric(y) Then
 .Cells(y, x).Value = .Cells(x, y).Value + Sheets("Sheet1").Range("C" & i).Value
 End If
 End If
 i = i + 1
 Loop
 End With
 
 MsgBox "転記が終了しました"
 
 End Sub
 
 
 |  |