| |
▼難問 さん：
>>A2の値は、"294072PG001"と"2040002PG001"で共通してない ように見えますが
>>C列が共通の項目なんでしょうか？
>
>B列とC列を結んだ値をA列にセットしています。
>サンプルであげているのはたまたま先頭行があっていないだけで
>2つのDBの各1万件の中には共通するものがあります。
Findで行う案を。
昔、作ったやつをちょっと手直ししただけなので上手く動作するか検証してません。
WorkSheets(1)、(2)のところを環境に合わせて編集。
Select Case i のあたりがデータをセットしているところになってます。
2つのBookを開いた状態で実行してみてください。
Option Explicit
Sub Find_Test()
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim Ran1 As Range, Ran2 As Range
Dim R As Range
Dim Fi As Range
Dim i As Long, j As Long
'前準備
Set Ws1 = Worksheets(1) 'ここを Workbooks("ｘｘ.xls").WorkSheets("シート名")に変更
Set Ws2 = Worksheets(2) '↑と同じ感じ
'Ws1.Columns(1).Insert Shift:=xlToRight 'A列を挿入する必要があるならコメント解除
'Ws2.Columns(1).Insert Shift:=xlToRight
With Ws1
Set Ran1 = Range(.Range("B2"), .Range("B65536").End(xlUp)).Offset(, -1)
End With
With Ws2
Set Ran2 = Range(.Range("B2"), .Range("B65536").End(xlUp)).Offset(, -1)
End With
Ran1.Formula = "=CONCATENATE(B2,C2)"
Ran1.Value = Ran1.Value
Ran2.Formula = "=CONCATENATE(B2,C2)"
Ran2.Value = Ran2.Value
'データ転記
For Each R In Ran1.Cells
Set Fi = Ran2.Find(R.Value, , xlValues, xlWhole, , , False, False)
If Fi Is Nothing Then
R.Offset(, 7).Value = "該当なし" 'Ws2になげれば.offset(,7)H列に"該当なし"
Else
For i = 7 To 11 'A列のOffset(,7)H列から11のJ列までにWs2のデータを代入
Select Case i
Case 7: j = 2 ',7(H列）に,2(C列）を
Case 8: j = 3 ',8(I列）に,3(D列）を 以下略
Case 9: j = 6
Case 10: j = 8
Case 11: j = 23
Case Else: j = 0
End Select
If j <> 0 Then R.Offset(, i).Value = Fi.Offset(, j).Value
Next i
End If
Next R
'後処理
Set Ws1 = Nothing: Set Ws2 = Nothing
Set Ran1 = Nothing: Set Ran2 = Nothing: Set Fi = Nothing
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
- 06/10/2(月) 12:28 -
