|
▼ごん さん:
以下でお試しください。
A1に あああ いいい ううう といったように半角スペースで区切られた
複数の検索文字列が入っているという前提で。
(文字列の数は制限なし)
Sub 検索2()
Dim c As Range
Dim v As Variant
Dim myStr As Variant
Dim ansR As Range
Dim f As Range
Dim i As Long
v = Split(Range("A1").Value) '半角スペースで区切られた検索文字列を取得
For i = LBound(v) To UBound(v)
v(i) = "*" & v(i) & "*" 'ワイルドカードに変更
Next
For Each myStr In v
If Len(myStr) > 0 Then
Set c = ActiveSheet.UsedRange.Find(What:=myStr, LookIn:=xlFormulas, LookAt:=xlWhole)
If Not c Is Nothing Then
Set f = c
Do
If ansR Is Nothing Then
Set ansR = c
Else
Set ansR = Union(ansR, c)
End If
Set c = ActiveSheet.UsedRange.FindNext(c)
Loop While c.Address <> f.Address
End If
End If
Next
MsgBox ansR.Address
If ansR Is Nothing Then
MsgBox "検索対象のものはありません"
Else
For Each c In ansR.Cells
c.Activate
If MsgBox("検索を続けますか?", vbYesNo) = vbNo Then Exit For
Next
End If
Set ansR = Nothing
Set c = Nothing
Set f = Nothing
End Sub
|
|