Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Pro : Excel 2016)
VBA検索範囲設定について
投稿日時: 22/06/12 18:01:09
投稿者: ちゃんこ

社内で使われているエクセルで、下記の動作を行っています。
シート「DB」⇒ データ入力・蓄積
シート「検索シート」⇒検索窓に検索ワード入力⇒マクロ実行ボタン⇒DBより検索ワードが
           含まれる列が表示。
 
「DB]シートのB列のみを検索範囲としたした結果を「検索シート」に反映させたいのですが
 B列以外からも検索ワードを引っ張ってきてしまうので、精度が低くなっています。
 以下サンプルですがTFCDは表示される必要がないので、あくまでB列での検索としたいの
 です。
 
 Ex. 検索ワード ESG  
   
   検索結果
   
   単語(B列)   意味    補足
   ESG      〇〇〇   〇〇〇    
   ESG投資    〇〇〇   〇〇〇
   TFCD     〇〇〇   ESG概念が広く〜 ←この列はいらない。
 
マクロ内容は以下の通りです。修正すべき個所をご教示いただきたく宜しくお願い致します。
 
 
Dim ws1, ws2 As Worksheet
 
Sub 検索()
     
    Set ws1 = Worksheets("検索シート")
    Set ws2 = Worksheets("DB")
     
    Call 削除
     
    '項目名のコピー
    ws2.Rows(1).Copy
    ws1.Range("A4").PasteSpecial
    Application.CutCopyMode = False
    ws1.Range("B2").Select
     
    Dim keyword As String
    keyword = ws1.Range("B2").Value
     
    Dim x, y, z As Long
     
    Dim word As String
     
    '項目数のカウント
    z = 1
    Do While ws2.Cells(1, z).Value <> ""
        z = z + 1
    Loop
    z = z - 1
     
    '検索ワードが含まれる内容を抽出
    x = 5
    y = 2
     
    Do While ws2.Cells(y, 1).Value <> ""
         
        '検索対象をまとめる
        word = ""
        For i = 1 To z
            word = word & ws2.Cells(y, i).Value
        Next i
         
        '検索を行う
        If word Like "*" & keyword & "*" Then
            For i = 1 To z
                ws1.Cells(x, i).Value = ws2.Cells(y, i).Value
            Next i
            x = x + 1
        End If
         
        y = y + 1
         
    Loop
     
End Sub
 
Sub 削除()
     
    Dim x, y As Long
     
    '項目数のカウント
    x = 1
    Do While ws1.Cells(4, x).Value <> ""
        x = x + 1
    Loop
    x = x - 1
     
    '行数のカウント
    y = 5
    Do While ws1.Cells(y, 1).Value <> ""
        y = y + 1
    Loop
    y = y - 1
     
    ws1.Range(ws1.Cells(5, 1), ws1.Cells(y, x)).Value = ""
     
End Sub

回答
投稿日時: 22/06/12 19:16:00
投稿者: taitani

「B列だけ」なのであれば、Z は不要ではないでしょうか。
また、i ではなく、2 でよいかと。

回答
投稿日時: 22/06/12 23:19:50
投稿者: WinArrow
投稿者のウェブサイトに移動

検索→転記=抽出処理は、
オートフィルタ
または
フィルタオプション
を使うと、コードがすっきりするし、今後のメンテナンスのために可動性が向上します。
Do〜Loopより、処理速度が速くなります。
 
マクロの記録でコード(基本の骨組み)を作成できます。
後は、作成されたコードを不要部分を削除したり、統合、などすればよいでしょう。
 
DO〜Loopをやめる前提で検討してみませんか?
 
それから
>Dim ws1, ws2 As Worksheet
変数:ws1はworksheetにはなっていませんよ。
Dim ws1 As Worksheet,ws2 As worksheet
にしましょう。
 
>Dim x, y, z As Long

Dim x As Long, y As Long, z As Long
に修正しましょう。

投稿日時: 22/06/13 03:44:51
投稿者: ちゃんこ

Win Arrow様 taitani様
 
リアクションありがとうございます。
自力でも元の内容を読み取りながらやってみて
⇒の内容に変更したところ求める結果を得ることができました。
これがスマートな方法なのかはわかりませんが、希望の動作が確認できたので
これにて解決とします。
貴重なお時間を愚問に割いていただきましたこと深謝いたします。
 
 
 '検索対象をまとめる
        word = ""
        For i = 1 To z ⇒ 1To 1+1
            word = word & ws2.Cells(y, i).Value
        Next i