|
▼jun さん:
おはようございます。
Match関数使うと、ちょっとだけスッキリしたので
別解です。
'==========================================================
Sub main3()
Dim s1rng As Range
Dim s2rng As Range
Dim s1crng As Range
Application.ScreenUpdating = False
With Worksheets("sheet1")
Set s1rng = .Range("a1", .Cells(.Rows.Count, 1).End(xlUp))
End With
With Worksheets("sheet2")
Set s2rng = .Range("a1", .Cells(.Rows.Count, 1).End(xlUp))
For Each s1crng In s1rng
With s2rng.Offset(0, 1)
Worksheets("sheet2").Range(.Cells(Mymatch(s1crng, s2rng)), .Cells(Mymatch(s1crng.Offset(0, 1), s2rng))).Value = s1crng.Offset(0, 4).Value
End With
Next
End With
Application.ScreenUpdating = True
End Sub
'=========================================================
Function Mymatch(rng1 As Range, rng2 As Range) As Long
On Error Resume Next
Mymatch = WorksheetFunction.Match(rng1, rng2, 1)
On Error GoTo 0
End Function
|
|