Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


38757 / 76732 ←次へ | 前へ→

【43108】Re:VLOOKUP
回答  ハチ  - 06/10/2(月) 14:38 -

引用なし
パスワード
   ▼難問 さん:
>>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("xx.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

0 hits

【43099】VLOOKUP 難問 06/10/2(月) 11:43 質問
【43100】Re:VLOOKUP ハチ 06/10/2(月) 12:27 発言
【43104】Re:VLOOKUP 難問 06/10/2(月) 13:02 発言
【43108】Re:VLOOKUP ハチ 06/10/2(月) 14:38 回答
【43166】Re:VLOOKUP 難問 06/10/4(水) 12:50 お礼
【43101】Re:VLOOKUP inoue 06/10/2(月) 12:28 発言
【43105】Re:VLOOKUP 難問 06/10/2(月) 13:04 発言
【43127】Re:VLOOKUP inoue 06/10/3(火) 0:51 発言
【43167】Re:VLOOKUP 難問 06/10/4(水) 12:51 お礼
【43118】Re:VLOOKUP りん 06/10/2(月) 19:33 発言

38757 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free