〔EXCEL〕でセル範囲の検索を行いたい

質問

エクセルで、薬品のデーターベースを作りました。
そこで、検索をしたいのですが、
たとえば、
B9～B100の薬品名が、
A9～A50の薬品名と一致した場合、
A9～A50の文字の色をつけたいです。

そこで、部分一致も行いたいのですが、
たとえば、
B9が、グリセリル
として、
A9～A50の中に
PCAオレイン酸グリセリル
というものがあった場合、
グリセリルの文字の色をつけることはできますか。
または、PCAオレイン酸グリセリル
の文字全体に色をつけてもかまいません。

宜しくお願いします。

回答No.1

x0000x · ベストアンサー

こんにちは。

こんな感じでどうですか？

対象シートのマクロとして以下を記述します。
「'セル背景色を黄色」の行をコメント解除する事で背景色も設定しています。

Sub setColor()
Dim AmaxRow, BmaxRow As Long

With ActiveSheet
AmaxRow = .Cells(.Rows.Count, "A").End(xlUp).row
BmaxRow = .Cells(.Rows.Count, "B").End(xlUp).row

Dim str As String
Dim ar, br As Long

For br = 9 To BmaxRow
Dim c As Range
Set c = .Range("A9:A" & AmaxRow).Find(.Cells(br, 2), LookIn:=xlValues)

If Not c Is Nothing Then

Dim fAddr As String
fAddr = c.Address

Do
'c.Interior.ColorIndex = 6 'セル背景色を黄色
Call setCharColor(c, .Cells(br, 2)) '部分一致文字の色付け

Set c = .Range("A9:A" & AmaxRow).FindNext(c)
Loop While Not c Is Nothing And c.Address <> fAddr

End If
Next
End With
End Sub

Sub setCharColor(ByRef rg As Range, ByVal str As String)

Dim st, length As Integer

st = InStr(rg.Value, str)
length = Len(str)

If st > 0 Then
rg.Characters(Start:=st, length:=length).Font.ColorIndex = 3 '文字列を赤色に！
End If
End Sub

お礼

できました☆ありがとうございます☆
マクロはべんりですね。。