社内で使われているエクセルで、下記の動作を行っています。
シート「ＤＢ」⇒ データ入力・蓄積
シート「検索シート」⇒検索窓に検索ワード入力⇒マクロ実行ボタン⇒ＤＢより検索ワードが
含まれる列が表示。
「ＤＢ］シートのＢ列のみを検索範囲としたした結果を「検索シート」に反映させたいのですが
Ｂ列以外からも検索ワードを引っ張ってきてしまうので、精度が低くなっています。
以下サンプルですがＴＦＣＤは表示される必要がないので、あくまでＢ列での検索としたいの
です。
Ex. 検索ワード ＥＳＧ
検索結果
単語（Ｂ列） 意味 補足
ＥＳＧ 〇〇〇 〇〇〇
ＥＳＧ投資 〇〇〇 〇〇〇
ＴＦＣＤ 〇〇〇 ＥＳＧ概念が広く〜 ←この列はいらない。
マクロ内容は以下の通りです。修正すべき個所をご教示いただきたく宜しくお願い致します。
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
