|    | 
     ▼ドカ さん: 
 
もし、ドガさんがシート関数の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 
 | 
     
    
   |