| |
解決した様ですが、少し速くなる方法を考えました、
Dictionaryを使えばもっと速く成りますが
取りあえず、コードを活かして以下の様にすると幾らか速くなると思います
条件として、Sheet1、Sheet2共に「顧客コード」をKeyとして整列しても構わないと言う事にします
Upされたコードでは、Sheet2から1つ取り出して、Sheet1と比較していますが
此れを逆にします、Sheet1から1つ取り出して、Sheet2と比較しています
この時、比較を開始する位置を前回見つかった位置からとします
（両シート共に整列している居る事により、前回見つかった位置因り上には同じコード無い）
Public Sub Test_2()
Dim i As Long
Dim j As Long
Dim wksS1 As Worksheet
Dim wksS2 As Worksheet
Dim lngCount As Long
Dim s1max As Long
Dim s2max As Long
Set wksS1 = Sheets("補助１")
Set wksS2 = Sheets("補助２")
With wksS1
s1max = .Range("A" & .Rows.Count).End(xlUp).Row
'「顧客コード」をKeyとして整列
.Range("A2:H" & s1max).Sort _
Key1:=.Range("B2"), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, SortMethod:=xlStroke
End With
With wksS2
s2max = .Range("A" & .Rows.Count).End(xlUp).Row
'「顧客コード」をKeyとして整列
.Range("A2:D" & s2max).Sort _
Key1:=.Range("B2"), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, SortMethod:=xlStroke
End With
lngCount = 2
For i = 2 To s1max
For j = lngCount To s2max
'「顧客コード」が等しいならForを抜ける
If wksS1.Cells(i, 2) = wksS2.Cells(j, 2) Then
Exit For
End If
Next j
'Sheet2から「顧客コード」が見つかった場合
If j <= s2max Then
'顧客名、住所を転記
' wksS1.Cells(i, 6).Resize(, 2).Value _
' = wksS2.Cells(j, 3).Resize(, 2).Value
wksS1.Cells(i, 7).Resize(, 2).Value _
= wksS2.Cells(j, 3).Resize(, 2).Value
'Sheet2の探索開始位置を変更
lngCount = j
Else
'Sheet2の探索開始位置を先頭に変更
lngCount = 2
End If
Next i
Set wksS1 = Nothing
Set wksS2 = Nothing
End Sub
|
|
Hirofumi
- 08/11/16(日) 11:53 -
