|
全文検索について教えてください
同じ値の検索は下記で出来たのですが、全文検索がうまく出来ません。
同じ値の検索は下記で何とかできたのですが、下記のRange("F1")(例えば
「家族」など)を含むセルを検索し取り込む方法が分かりません。
設定の仕方を教えてください。よろしくお願いします。
Sub ワード全文検索()
Dim GOOD As String
Dim シート名1 As String
Dim シート名2 As String
シート名1 = "元データ" '検索対象のシート
シート名2 = "GOOD情報" 'ここに検索したセルを集める
GOOD = Worksheets(シート名2).Range("F1") 'F1は家族など
i = 2
Worksheets(シート名2).Select '検索のセルをシート名2に集めます
Do While Sheets(シート名1).Cells(i, 2) <> ""
If Sheets(シート名1).Cells(i, 2) = GOOD Then
'If Columns(2).Find(Worksheets(シート名2).Range("F1").Value) = GOOD Then
ActiveSheet.Range("B100").End(xlUp).Offset(1, 0).Select
Selection.Value = Sheets(シート名1).Cells(i, 3)
ActiveCell.Offset(0, 1).Value = Sheets(シート名1).Cells(i, 4)
End If
i = i + 1
Loop
Range("A1").Select
End Sub
|
|