エクセルマクロのCells.Findについて

質問

• エクセルマクロのCells.Findを使用して、特定の文字列を含むセルを検索する方法について教えてください。
• Cells.FindのWhat:=の記入方法を工夫することで、スペルという文字列を検索する際にゴスペルという文字列を排除しながら検索することが可能です。
• また、他の方法でも特定の文字列を含むセルを検索することができます。

回答No.9

matsu_jun · ベストアンサー

tktkmanureさん、おはようございます。
とりあえずはマクロの作成を始めておられると思います。
今回は利用しないかもしれませんが、参考になさってください。
前回は区切り文字が一つ（例では"、"）としていましたが、今回は区切り文字を利用しないものを作成してみました。
また、Publicの関数としたので、標準モジュールないしはThisWorkbookモジュールに貼り付けてもらえばどこのシートからでも呼び出すことができます。
前回と同じ部分からはコメントを外しています。

'-----------------ここからコピー-------------------

Public Function FindSpecial(TgtKey As String, TgtRng As Range, ExcKey() As String, AftRng As Range) As Range
'TgtKey : 検索対象となる文字
'TgtRng : 検索範囲（レンジで指定）
'ExcKey : 検索から除外する文字（配列で指定）
'AftRng : AftRngより先のセルから検索
　　Dim FirstFind As Range
　　On Error Resume Next　　'AftRngが検索範囲外であった場合のエラー回避処理
　　Set FindSpecial = TgtRng.Find(TgtKey, After:=AftRng)
　　　　If Err.Number <> 0 Then
　　　　　　Set AftRng = TgtRng.Item(1)　　'AftRngを、TgtRngの左上に再設定
　　　　　　Set FindSpecial = TgtRng.Find(TgtKey, After:=AftRng)　　'再探索
　　　　End If
　　On Error GoTo 0
　　If Not (FindSpecial Is Nothing) Then
　　　　Set FirstFind = FindSpecial
　　　　If FindExeclude(TgtKey, FindSpecial.Value, ExcKey()) Then Exit Function　　'SplKeyを撤去
　　　　Do Until (FindSpecial Is Nothing)
　　　　　　Set FindSpecial = TgtRng.FindNext(FindSpecial)
　　　　　　If FindSpecial.Address = FirstFind.Address Then Exit Do
　　　　　　If FindExeclude(TgtKey, FindSpecial.Value, ExcKey()) Then Exit Function　'SplKeyを撤去
　　　　Loop
　　End If
　　Set FindSpecial = Nothing
End Function

Private Function FindExeclude(TgtKey As String, TgtStr As String, ExcKey() As String) As Boolean
'FindSpecialの補助関数
'TgtKey : 検索する文字
'TgtStr : とりあえず検索したセルの中身（検索対象）
'ExcKey : 検索から除外する文字（配列で指定）

　　Dim TgtPt, ExcPt, CmpPt As Integer
　　'TgtPt : 検索対象文字中の検索文字の先頭位置
　　'ExcPt : 検索対象文字中の除外文字の先頭位置
　　'CmpPt : 除外文字中の検索文字の先頭位置

　　TgtPt = InStr(TgtStr, TgtKey)　　'例:"プロゴスペル歌手とアマゴスペル歌手"中、"スペル"は、4文字目から始まる→TgtPt = 4

　　Do While (TgtPt <> 0)　　'検索対象文字から検索対象が見つかっていれば以下の処理を実施
　　　　FindExeclude = True
　　　　For i# = 0 To UBound(ExcKey)　　'除外文字の全てにおいて下記の処理を実施
　　　　　　CmpPt = InStr(ExcKey(i), TgtKey)　　'例:"ゴスペル"中、"スペル"は、2文字目から始まる→CmpPt = 2
　　　　　　ExcPt = InStr(TgtStr, ExcKey(i))　　'例:"プロゴスペル歌手とアマゴスペル歌手"中、"ゴスペル"は、3文字目から始まる→CmpPt = 3
　　　　　　If ExcPt <> 0 And ExcPt + CmpPt - 1 = TgtPt Then　　'TgtStr中、検索されたTgtKeyとExcKeyが同じかどうかの判断
　　　　　　　　FindExeclude = False
　　　　　　　　Exit For　　'同じものであれば、次の検索対象へ検索を移行
　　　　　　End If
　　　　Next i
　　　　If FindExeclude Then Exit Function
　　　　TgtStr = Right(TgtStr, Len(TgtStr) - TgtPt)　　'検索対象文字に複数の検索文字があることを想定し、左端の検索済みの文字を削除
　　　　'例:検索対象を「プロゴスペル歌手とアマゴスペル歌手」→「ペル歌手とアマゴスペル歌手」
　　　　TgtPt = InStr(TgtStr, TgtKey)
　　　　'例：1回目の処理だと、TgtPt = 9となるが、2回目は、「ペル歌手」しか残らないので、2回目はTgtPt = 0となる
　　Loop

End Function

'-----------------ここまでコピー-------------------

以下、試験用のサンプルプログラムです。

Private Sub CommandButton1_Click()
　　Dim JOGAI() As String
　　Dim ResultRange As Range
　　n# = 0
　　Do While (Cells(n + 1, 3) <> "")
　　　　ReDim Preserve JOGAI(n)
　　　　JOGAI(n) = Cells(n + 1, 3).Value
　　　　n = n + 1
　　Loop
　　FindSpecial(Range("B1"), Range("A:A"), JOGAI, ActiveCell).Select
End Sub

今回は前回と趣向を変え、A列に検索対象文字を羅列してもらって、B1セルに検索したい文字、C列に除外したい文字列を1つずつ下向きに入れてもらうこととしました。
前回は、Split関数を用いて配列に値を格納する方法の例示としてあげましたが、今回は実際に配列を操作する時に、配列の上限をフレキシブルに変更する例（ReDim Preserve）として書いてみました。

では、良きVBAライフを。

お礼

matsu_jun様

お礼が遅くなりました。上記マクロ、大変ありがとうございました。少し修正して実際に使用させていただきました。修正したのは、大文字／小文字や全角／半角の区別有／無を指定してFindSpecialを実行できるようにしました。

Public Function FindSpecial(TgtKey As String, TgtRng As Range, ExcKey() As String, AftRng As Range) As Range
Private Function FindExclude(TgtKey As String, TgtStr As String, ExcKey() As String) As Boolean

↓Find関数におけるMatchCaseとMatchByteのようなパラメータ追加

Public Function FindSpecial(TgtKey As String, TgtRng As Range, ExcKey() As String, AftRng As Range, myMatchCase As Boolean, myMatchByte As Boolean) As Range
Private Function FindExclude(TgtKey As String, TgtStr As String, ExcKey() As String, myMatchCase As Boolean, myMatchByte As Boolean) As Boolean

FindExcludeで使用されているInStr関数は、デフォルトでは大文字・小文字を区別し、全角・半角は区別しないようなので、例えばFindExclude内TgtPtの計算を下記のように2×2=4通りに場合分けしました。
TgtPt = InStr(UCase(TgtStr), UCase(TgtKey))
TgtPt = InStr(TgtStr, TgtKey)
TgtPt = InStr(1, UCase(TgtStr), UCase(TgtKey), vbBinaryCompare)
TgtPt = InStr(1, TgtStr, TgtKey, vbBinaryCompare)

Findと同じ感覚でFindSpecialを使用できるので、今後重宝しそうです。本当にありがとうございました！