引用:
Set rngFnd = Cells.Find(What:=v, LookAt:=xlPart, MatchCase:=True)
引用:
「ワード」に関しては他にも「word」「WORD」なども検索対象にしています。
その他の文字としては（こちらは問題ないのですが）「iPAD」「IPAD」
「office」「オフィス」「excel」「EXCEL」「エクセル」などもあります。
とりあえずバイナリ比較方式で検索する場合。
（標準モジュール）
-------------------------------------------------------------------
Sub 検索() '検索対象：アクティブシート
Dim varArray As Variant
Dim v As Variant
Dim strAddress As String
Dim rngFnd As Range
Dim rngUni As Range
Dim cell As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'全てのセルの塗りつぶしを「色なし」に
Cells.Interior.ColorIndex = xlColorIndexNone
varArray = Array("ワード", "エクセル") '検索文字列を1次元配列で指定
Dim shp As Excel.Shape
Dim txr As Office.TextRange2
'空のテキストボックスを一時的に作成する
Set shp = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 100, 100)
'非表示化
shp.Visible = False
'テキストボックスの文字列範囲の参照
Set txr = shp.TextFrame2.TextRange
For Each v In varArray
'まず部分一致するセルを検索する
Set rngFnd = Cells.Find(What:=v, LookAt:=xlPart, MatchCase:=True)
'ヒットした場合
If Not rngFnd Is Nothing Then
strAddress = rngFnd.Address '最初に検索一致したセルの番地格納
Do
'ヒットしたセルの値をテキストボックスに代入する
txr.Text = rngFnd.Value
'単語レベルでの文字列検索でマッチした場合
If FindWordInTextRange(shp.TextFrame2.TextRange, CStr(v)) = True Then
If rngUni Is Nothing Then
Set rngUni = rngFnd
Else
Set rngUni = Union(rngUni, rngFnd) 'セルを集合
End If
End If
Set rngFnd = Cells.FindNext(rngFnd) '次の一致セルを検索
Loop Until strAddress = rngFnd.Address 'セルのアドレスが一致したらループを抜ける
End If
Next
If Not rngUni Is Nothing Then rngUni.Interior.ColorIndex = 6 '検索一致セルの選択
'作成したテキストボックスの後始末
Set txr = Nothing
shp.Delete
Set shp = Nothing
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
'MsgBox "処理終了"
End Sub
'TextRange2 オブジェクトの機能を利用して単語レベルでの文字列検索を行なう関数
Private Function FindWordInTextRange(TextRange As Office.TextRange2, Keyword As String) As Boolean
'ヒットしなければ False を返す
FindWordInTextRange = False
'キーワードが空文字列なら抜ける
If Keyword = "" Then
Exit Function
End If
Dim lngWordCount As Long
Dim strJoinedWords As String
'単語連結文字列の初期化
strJoinedWords = ""
With TextRange
'テキストボックスの文字列範囲に含まれる単語の数だけループ
For lngWordCount = 1 To
.Words.Count
'n個目の単語をイミディエイトウィンドウに出力（デバッグ用）
Debug.Print .Words(lngWordCount)
'前方一致し続ける限り単語を追記する
strJoinedWords = strJoinedWords &
.Words(lngWordCount)
'キーワードと前方一致する場合
If Keyword Like (strJoinedWords & "*") Then
'かつバイナリ比較方式で完全に一致する場合
If
StrComp(Keyword, strJoinedWords, vbBinaryCompare) = 0 Then
'Trueを返してプロシージャを抜ける
FindWordInTextRange = True
Exit Function
End If
Else
'前方一致しなければ単語連結文字列を初期化
strJoinedWords = ""
End If
Next
End With
End Function
-------------------------------------------------------------------
但し、日本語の文章（特に人名、地名、固有名詞、スラングが
含まれる文章、助詞が省略された文章など）を対象とした
識別の精度は、英文のそれよりも遙かに落ちるはず。
例えば「去年の流行語大賞の発表は12月1日でした」という文章から
「流行語」という単語を検索する場合、「流行語大賞」という文字列は
1つの固有名詞ではなく「流行語」と「大賞」という2つの名詞に分けられ、
ヒットの対象となります。
