|    | 
     ▼ドカ さん: 
 
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 
 | 
     
    
   |