表にリストの文字列を含むセルに着色したい

質問

いつも大変お世話になっております。

添付図のような文字列がちりばめられた表から、範囲を指定してリストに入力した文字列を含むセルにリストの色で着色したい。
これを今まで手作業してましたが、ソロソロ限界ですので何とかならないかと。。。

例えば、A列からD列の表で、B5:C10の範囲を指定して、別に枠取りしたリストに文字列を入力すると、リストの色を前方一致で、図の場合、B7とC8が緑、B9は青に・・というように着色したいのです。

表の大きさやリストの対象文字列の数はシートによってマチマチです。

検索対象範囲、リストの範囲はコード中で指定出来れば汎用性がでるのでありがたいです。

回答No.8

SI299792 · ベストアンサー

画像の見る限り「リスト」という文字を探して、
左を検索対象範囲、下をリストの範囲にすれば、
いちいち範囲指定をする必要が無く、シートを開いて実行するだけでいいのではないか。
必ず「リスト」の文字がある前提です。
Option Explicit
'
Sub Macro1()
　　Dim StartAddress As String
　　Dim List As Range
　　Dim Find As Range
　　Dim Area As Range
'
　　Set Find = Cells.Find("リスト", LookAt:=xlWhole).Offset(1)
　　Set List = Cells(Rows.Count, Find.Column).End(xlUp)
　　Set Area = [A:A].Resize(, Find.Column - 1)
　　Area.Interior.Pattern = xlNone
　　Application.ScreenUpdating = False
'
　　For Each List In Range(Find, List)
　　　　Set Find = Area.Find(List, LookAt:=xlPart)
'
　　　　If List > "" And Not Find Is Nothing Then
　　　　　　StartAddress = Find.Address
'
　　　　　　Do
　　　　　　　　Find.Interior.Color = List.Interior.Color
　　　　　　　　Set Find = Area.FindNext(Find)
　　　　　　Loop Until Find.Address = StartAddress
　　　　End If
　　Next List
End Sub

お礼

これは（当方の）想像を絶する究極のプロシージャーです！

シートに「着色」の実行ボタンを配置して、諸々一発解決できました。

補足

BSにして早々に閉め切ろうと思い、他のご回答者にお礼を書きながら、こんな回答が得られるならもう少しシートのレイアウトを考えて例示すればよかった！！と「後知恵」・・・

で、やっぱり、もし可能なら非常に厚かましいのですが
１．リストを表の左側（AとかB列）
に改良してもらえないでしょうか？

表が結構大きく、列数もマチマチなので、A列（やB列）にリストがあった方が非常に使い易いので。

回答No.1

msMike

その説明、添付図の何処が「前方一致で、B7とC8が緑、B9は青に」なってるのかサッパリポンですゥ～ｯ！

お礼

早々のお回答ありがとうございます。
質問の仕方が悪く申し訳ありませんでした。