エクセル 複数の文字を同時に検索したい。

シート内にある複数の文字を同時に検索出来る方法を教えて頂きたいです。
ネットからコピペして、1つ文字を検索する方法は出来たのですが、同時にもう２つの異なる
文字で検索出来るようにしたいです。

検索したい文字：①A　②B　③C

Sub Sample6()
Dim FoundCell As Range, FirstCell As Range, Target As Range
Set FoundCell = Cells.Find(What:="A")
If FoundCell Is Nothing Then
MsgBox "見つかりません"
Exit Sub
Else
Set FirstCell = FoundCell
Set Target = FoundCell
End If
Do
Set FoundCell = Cells.FindNext(FoundCell)
If FoundCell.Address = FirstCell.Address Then
Exit Do
Else
Set Target = Union(Target, FoundCell)
End If
Loop
Target.Select
MsgBox Target.Count & "件見つかりました"
End Sub

このマクロにBとCを追加した状態にしたいのですが、コードをどういう風に追加すればいいのか分かりません。
ご存知の方いましたら、教えて頂きたいです。
よろしくお願いします。

No.2 ベストアンサー 回答者： tom04 回答日時： 2017/10/08 08:30

No.1です。

もう一度お示しのコードを確認させていただくと
「部分一致」での検索ですね。どうも失礼しました。

前回のコードは「完全一致」の検索なので、該当セルがない場合
そのようなエラーになるのではないかと思います。
前回のコードに少し手を加えてみました。

Sub Sample1()
Dim k As Long, myAry As Variant
Dim FoundCell As Range, FirstCell As Range, myRng As Range
myAry = Array("A", "B", "C")
For k = 0 To UBound(myAry)
Set FoundCell = Cells.Find(what:=myAry(k), LookIn:=xlValues, lookat:=xlPart) '//★①//
If Not FoundCell Is Nothing Then
Set FirstCell = FoundCell
GoTo 処理
Do
Set FoundCell = Cells.FindNext(after:=FoundCell)
If FoundCell.Address = FirstCell.Address Then Exit Do
GoTo 処理
処理:
If myRng Is Nothing Then
Set myRng = FoundCell
Else
Set myRng = Union(myRng, FoundCell)
End If
Loop
End If
Next k
If Not myRng Is Nothing Then '//★②//
myRng.Select
MsgBox myRng.Count & "　件見つかりました。"
Else
MsgBox "該当セルなし。"
End If '//★③//
End Sub

※　「★①」の行が「部分一致」の検索
そして、「★②」～「★③」で該当セルがない場合のエラー処理をしています。m(_ _)m

この回答へのお礼

tom04様、ご回答ありがとうございます。
こちらのマクロを使用して、自分の理想とする形に出来ました！
ありがとうございました！

お礼日時：2017/10/08 11:33

No.1 回答者： tom04 回答日時： 2017/10/08 01:22

こんばんは！

一例です。

Sub Sample1()
Dim k As Long, myAry As Variant
Dim FoundCell As Range, FirstCell As Range, myRng As Range
myAry = Array("A", "B", "C")
For k = 0 To UBound(myAry)
Set FoundCell = Cells.Find(what:=myAry(k), LookIn:=xlValues, lookat:=xlWhole)
If Not FoundCell Is Nothing Then
Set FirstCell = FoundCell
GoTo 処理
Do
Set FoundCell = Cells.FindNext(after:=FoundCell)
If FoundCell.Address = FirstCell.Address Then Exit Do
GoTo 処理
処理:
If myRng Is Nothing Then
Set myRng = FoundCell
Else
Set myRng = Union(myRng, FoundCell)
End If
Loop
End If
Next k
MsgBox myRng.Count & "　件見つかりました。"
End Sub

こんな感じでも大丈夫だと思います。m(_ _)m

この回答へのお礼

tom04様、ご回答ありがとうございます。
こちらのマクロを使用してみたのですが、

MsgBox myRng.Count & "　件見つかりました。"
この部分に実行時エラー91が発生しました。
どう修正したらいいでしょうか？
よろしくお願い致します。

お礼日時：2017/10/08 01:41