|
▼まいった! さん:
何度も何度もシートの範囲を Findするのは面倒なので、
Dictionaryオブジェクトに最初に登録しておいたらどうでしょう
Sub Try1()
Dim WS3 As Worksheet
Dim WS4 As Worksheet
Set WS3 = Worksheets("Sheet3")
Set WS4 = Worksheets("Sheet4")
'WS4のG列の値と WS3のB列の値とを比較、
'WS4のI列の値を、WS3のG列に書き込む。
Dim a1, a2
Dim b1, b2
Dim i As Long
Dim dic As Object
'(1)WS4 のG列とI列の値を Dictionaryに登録
With WS4.Range("G:G")
With Excel.Range(.Item(1), .Item(.Count).End(xlUp))
b1 = .Value
b2 = .Offset(, 2).Value
End With
End With
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(a1)
dic(b1(i, 1)) = b2(i, 1)
Next
'(2)WS3のB列の値(a1配列)が Dictionaryのキーにあれば、 _
DictionaryのItemを配列a2にコピー
With WS3.Range("B:B")
With Excel.Range(.Item(1), .Item(.Count).End(xlUp))
a1 = .Value
ReDim a2(1 To UBound(a1), 1 To 1)
For i = 1 To UBound(a1)
If dic.Exists(a1(i, 1)) Then
a2(i, 1) = dic(a1(i, 1))
End If
Next
.Offset(, 5).Value = a2
End With
End With
Set dic = Nothing
End Sub
|
|