マクロのCells.Findについて

質問

エクセルマクロのCells.Findについて教えてください。
特定の文字列を含むセルを検索するときにCells.Findを使うと思うのですが、例えば、「スペル」という文字列を検索したいけれども、「ゴスペル」というような文字列は排除しながら検索できますか？「スペル」と入力されているセルと、「ゴスペル」と入力されているセルと、「スペル、ゴスペル」と入力されているセルがあったときに、「スペル」や「スペル、ゴスペル」と入力されているセルを検索したいです。
Cells.FindのWhat:=の記入中身を工夫すればできないかなと頭を悩ませていますが、Cells.Find以外の方法でも結構です。どうか宜しくお願いします。

回答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を使用できるので、今後重宝しそうです。本当にありがとうございました！

回答No.8

mt2008

ANo.1です。
Findに拘らないのであれば、こんな感じでも良いじゃないでしょうか。
やっている事はANo.5と同じ様な事です。

Sub Sample1()
　　Dim sTarget As String
　　Dim sDel As String
　　Dim rRange As Range
　　Dim sWork As String

　　sTarget = "スペル" '検索文字列
　　sDel = "ゴスペル" '除外文字列
　　For Each rRange In ActiveSheet.UsedRange
　　　　sWork = Replace(rRange, sDel, "") '除外文字列を除外
　　　　’検索文字列があったらセルを赤くする
　　　　If InStr(sWork, sTarget) > 0 Then rRange.Interior.ColorIndex = 3
　　Next rRange
End Sub

お礼

mt2008さん
ありがとうございます。実はまだお教えいただいたロジックでのマクロ作成にとりかかっておりませんが、上記マクロを参考にさせていただきます。

回答No.7

matsu_jun

tktkmanureさん、おはようございます。ANo.6のmatsu_junです。

FindSpecialというファンクションを作ってみました。
FindSpecialの書式は以下のとおりです

FindSpecial(TgtKey, TgtRng, ExcKey(), SplKey, AftRng)
　TgtKey : 検索したい文字列です。質問中の「スペル」に相当します。
　TgtRng : 検索する範囲を示します。質問中では「Cells」に相当します。
　ExcKey() : 検索から除外したい文字列です。質問中の「ゴスペル」に相当しますが、
　　　　　　例えば「ゴスペル」だけでなく、「スペルチェック」や「スペルリスト」も除外したい場合
　　　　　　　ExcKey(0) = "ゴスペル"
　　　　　　　ExcKey(1) = "スペルチェック"
　　　　　　　ExcKey(2) = "スペルリスト"
　　　　　　とします。配列は必ず(0)から記載してください。
　　　　　　除外したいリストにない、上の例の場合、「スペルミス」などは検索対象となります。
　SplKey : セルの中で、幾つかの単語が続けて記載されている時に、単語どうしを分割している
　　　　　　記号です。質問中の「、」に相当します。実際の用途では区切り文字がないという場合でも
　　　　　　適当な文字（「、」のままでよいです）を入れておいて下さい。
　AftRng : TgtRngで指定した範囲における、検索スタートの位置を示します。一つのセル(例えばRange("A1"))で示します。
　　　　　　検索範囲を"A1:B10"とした時、ここにRange("A5")と記載すれば、1行目から4行目およびA5は検索対象に含まず
　　　　　　B5とA6からB10までの範囲で検索を行います。(Find関数のafterと同じものです)
　　　　　　省略はできないので、初めて検索する際は、検索範囲の左上のセルを記載してください。

FindSpecial は、Rangeオブジェクトになります。

なので、
　Dim ResultCell As Range
　Set ResultCell = FindSpecial( 以下 引数 … )
といった形で御利用ください。

さて、実際のコードを以下に示します。

試しに、以下をSheet1のモジュールにコピーしてください。

'------------------------------ここからコピー------------------------------------
Private Function FindSpecial(TgtKey As String, TgtRng As Range, ExcKey() As String, SplKey As String, AftRng As Range) As Range
'TgtKey : 検索対象となる文字
'TgtRng : 検索範囲（レンジで指定）
'ExcKey : 検索から除外する文字（配列で指定）
'SplKey : 検索するセルに複数の単語が含まれている際、それらを区切るためのキャラクター（例通りなら"、"）
'AftRng : AftRngより先のセルから検索
　　Dim FirstFind As Range　　'最初の検索結果を保持（検索が一周したことを検知するため）
　　Set FindSpecial = TgtRng.Find(TgtKey, After:=AftRng)
　　If Not (FindSpecial Is Nothing) Then
　　　　Set FirstFind = FindSpecial
　　　　'とりあえず「TgtKey」を含むセルの検索が終了。以下、検索結果から除外されるかどうかの判断
　　　　If FindExeclude(FindSpecial.Value, ExcKey(), SplKey) Then Exit Function　　'除外する文字で検索されていなければ、このセルを返り値として終了
　　　　Do Until (FindSpecial Is Nothing)　　'とりあえず検索した結果が、実は除外する文字でも検索されていたならば、次のセルを検索
　　　　　　Set FindSpecial = TgtRng.FindNext(FindSpecial)
　　　　　　If FindSpecial.Address = FirstFind.Address Then Exit Do　　'検索結果が1周したら、結果なしとして終了
　　　　　　If FindExeclude(FindSpecial.Value, ExcKey(), SplKey) Then Exit Function　　'除外する文字で検索されていなければ、このセルを返り値として終了
　　　　Loop
　　End If
　　Set FindSpecial = Nothing　　'ルーチンが本行まで実行された場合は結果なしと判断されるので、返り値をNothingとして終了
End Function

Private Function FindExeclude(TgtStr As String, ExcKey() As String, SplKey As String) As Boolean
'FindSpecialの補助関数（ユーザーは実際に呼び出さない）
'TgtStr : とりあえず検索したセルの中身
'ExcKey : 検索から除外する文字（配列で指定）
'SplKey : 検索するセルに複数の単語が含まれている際、それらを区切るためのキャラクター（例通りなら"、"）
　　Dim SplStr() As String
　　Dim FindCnt As Integer
　　FindExeclude = False
　　'TgtStrをSplKeyで分割し、配列に格納
　　SplStr = Split(TgtStr, SplKey)
　　For i# = 0 To UBound(SplStr)
　　　　FindCnt = 0
　　　　For j# = 0 To UBound(ExcKey)
　　　　　　FindCnt = FindCnt + InStr(SplStr(i), ExcKey(j))　　'配列データが、除外データに相当するかどうかの検索（除外データが含まれていたら、FindCntは、1以上の値となる
　　　　Next j
　　　　If FindCnt = 0 Then　　'全ての除外データについて確認し、それらが含まれていなければTrueを返す
　　　　　　FindExeclude = True
　　　　　　Exit Function
　　　　End If
　　Next i
End Function
'------------------------------ここまでコピー------------------------------------

試験方法として、以下をお試しください。

ExcelのシートのA1セルに、検索したい文字として
スペル
と入力してください。
A2セルに、検索から除外したい文字として
ゴスペル、スペルチェック、スペルリスト
と入力してください。（読点もそのまま入力してください）

後は同じシート上に、適当にデータを記入してみてください。
(上記の通り「スペルミス」は除外文字として登録していないので検索対象です。
適当なセルに「スペルミス」と入力してください)

それができたら、シート上にボタン(CommandButton1)を配置します。
で、以下をコピーして、同じモジュールに貼り付けます。

'------------------------------ここからコピー------------------------------------
Private Sub CommandButton1_Click()
　　Dim JOGAI() As String
　　Dim ResultRange As Range

　　JOGAI = Split(Range("B2"), "、")　　'…(1)
　　FindSpecial(Range("B1"), Cells, JOGAI, "、", ActiveCell).Select
End Sub
'------------------------------ここまでコピー------------------------------------

シートに戻って、ボタンを押してみてください。検索できた場所にカーソルが移っていきます。
そのまま連打すれば、次の検索場所にカーソルが移ります。

今回の例では、検索から除外したい文字列を、「、」で区切って1つのセルに入れています。
これを1つずつ配列に格納するには、上のコードの(1)の部分 (Split関数) を利用します。
1セル内に複数の文字列を改行して入れている場合（セルに文字入力中 Alt+Enterで改行させていた場合）
上の(1)の行は

　　JOGAI = Split(Range("B2"), Chr(10))

と書き換えられます。
今回作成した FindSpecial関数内の引数 SplKey についても、もし区切りの文字が改行であった場合は
Chr(10)を利用します。

よろしければお試しください。

お礼

matsu_junさん
大変お手数をおかけしました。ありがとうございました。
大変有用なファンクションだと思いますし、マクロ作成における物事の考え方が大変参考になります。ただ、これまた私の質問の仕方や情報が悪いのですが、複数の単語が含まれているセル内の区切り文字が、私の手元にある表の場合、「、」だったり、「,」だったり、改行だったり、スペースだったり、数字だったり、1つの表の中で統一されておらず、しかも1つのセルの中でそれらが混ざっていたりしています。作っていただいたマクロの修正を考えたのですが、ちょっと厳しそうです。今のところは、mt2008さんのANo.5やANo.8のロジックがより汎用的だと思いますので、そちらを使わせていただこうかと思います。

回答No.6

matsu_jun

tktkmanure様 こんばんは　matsu_junと申します。

今までのお話を総合してマクロを作ってみます。
少し（1日程度）お時間をいただけますでしょうか？

回答No.5

mt2008

ANo.1です。

補足を読みました。
そう言う事であれば、シートの内容を別シートにコピーし、そのシートで除外文字列（例：ゴスペル）を置換で削除した上で目的の文字列（例：スペル）で検索を行っては如何でしょう。

マクロが組める方のようですから、この作業をマクロ化して元のシートの該当セルの色を変えるなどの処理を加えれば良いでしょう。

お礼

ありがとうございます。
なんとなくできそうな気がしてきました。がんばってマクロ作ってみます。
それにしても、検索するときにキーワードを“スペル but not ゴスペル”のように設定して検索できる機能があれば、便利なのですが。。いずれにしてもありがとうございました。またご報告します。

回答No.4

KURUMITO

回答No3です。

If WorksheetFunction.CountIf(Cells(RowPos, 1), "スベル*") > 0 Then

を次のようにすればよいように思いますね。

If WorksheetFunction.CountIf(Cells(RowPos, 1), "スベル*") > 0　Or WorksheetFunction.Countif(Cells(RowPos,1),"*、スベル")>0 Then

お礼

ありがとうございます。このマクロだと、私が挙げた例でのみ使用できそうですね。
やはりワイルドカードを使用せずにマクロを組みたいと思いますので、ANo5の方の回答で試してみたいと思います。

回答No.3

KURUMITO

例えば次のようなマクロにすることで良いでしょう。

RowPos = 0
Do
RowPos = RowPos + 1
If WorksheetFunction.CountIf(Cells(RowPos, 1), "スベル*") > 0 Then
Cells(RowPos, 2) = 1
Else
Cells(RowPos, 2) = 0
End If
Loop Until Cells(RowPos, 1) = ""

補足

ありがとうございます。お返事が遅くなりました。
言葉足らずなところがありました。「スペル」「スペル、ゴスペル」「ゴスペル、スペル」「ゴスペル」と入力されたセルがあるときに、「スペル」「スペル、ゴスペル」「ゴスペル、スペル」のセルを抜き出したいです。ワイルドカード等を用いずに、検索文字列を「スペル」、排除する文字列を「ゴスペル」と「設定」して、条件付きの検索をしたいです。
具体的に私がやりたいのは、農薬の作物毎の使用一覧表（各行の一番左に作物の名称、その右のセルに使用される複数の農薬が1つのセルの中に入力されています）があって、「ペルメトリン」を検索するときに「シペルメトリン」を排除しながら検索、「アルジカルブ」を検索するときに「アルジカルブスルホキシド」を排除しながら検索したいです。今のところ、あるブック内の第１列の各セルに農薬名が入力されたリストがあって、上から下まで順番に、各農薬をキーワードとして、別ブックの作物農薬使用一覧表を検索し、キーワードが含まれる行を抜き出して、また別のブックに保存するマクロは作れています。キーワードとなる農薬名の右側に排除する文字列を（複数でも）記入しておき、上記のやりたい処理をできないかと考えています。宜しくお願いします。

回答No.2

mt2008

ANo.1です。

質問の意味を取り違えていたみたいですね。

「スペル」で始まる文字列が入っているセルを検索したいと言う事であってますか？それでしたら検索文字列にワイルドカードを使う事で検索出来ます。
こんな感じ↓
.Cells.Find("スペル*")　

これで、「スペル」「スペル、ゴスペル」は検索出来ます。
「ゴスペル」「ゴスペル、スペル」は検索出来ません。

補足

ありがとうございます。ANo.3の方にもお返事しましたが、検索キーワード毎に排除する文字列を「設定」して検索する方法を考えています。宜しくお願いします。

回答No.1

mt2008

引数LookAtで検索方法を変える事が出来ます。

「ゴスペル」等を含めない完全一致の場合
　　.Cells.Find(What:="スペル", LookAt:=xlWhole)

「ゴスペル」等を含める部分一致の場合
　　.Cells.Find(What:="スペル", LookAt:=xlPart)
または単純に
　　.Cells.Find(What:="スペル")