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