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

質問

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

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

例えば、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.12

SI299792

imogasiの言うとおり、私のプログラムは、入力直後に色が変わらす、変更があればその都度プログラムを実行する必要があります。

質問には、変更後すぐに色が変わると書いて無かったので、それでいいと判断しました。

お礼

ハイ、むしろ実行ボタンで実行する方が使い易いですし、そのつもりで質問しました。
（言い訳になりますが、自作出来ないレベルなので細部に気が付かない）

実際の使用方法は目的とする文字列をリストに入力し、検索実行です。
複数回に分けて実行することもありますので一々色が変わったらかえって煩わしいと思いますので。

回答No.11

SI299792

リストを表の左側という事は、
Ｆ列にリストがあれば、Ｇ列以右が対象ですか？

　　Set Area = Columns(List.Column + 1).Resize(, Columns.Count - List.Column)

に直して下さい。
私の様に、昼間回答しない人もいるので、１日待った方がいいです。

お礼

ハイ、ご回答が夜だったので一晩は待つつもりでした。

無事期待通りに動くことを確認しました。

最初の回答で即〆切のつもりでしたが段々欲が出てきて・・・
これでリストが対象表の左右どちらでも使えるようになりました。

シートによっては左に列を挿入すると既のにVBAに影響する可能性のあるシートもありますので、列を挿入しないことを前提で表の右側をイメージして質問した次第です。

あの添付図からのご推察に感心しました。
範囲は都度指定するもの、との感覚でした。
今後の同様の質問時に別の意味でも有用なご回答で、併せて御礼申し上げます。

回答No.10

imogasi

ある回答にべたぼれのようだが、小生が条件付き書式を使った
VBAのコードに拘わったのは、元のデータを修正したり、変わった時
即座に正しく反応してくれるためだ。
Find法では、もう一度プログラムを実行しないとならないはず。
（実験済み）
この再実行をしなくても反応してくれるコードも書けると思うが
難しいように思う。
＝＝＝
ただ本質問の例に限れば、検索範囲のデータが、プログラム実行後に
変わることはないように思うのだが、一般には、即座に正しく
反応してくれるのはありがたいと思って、いつも、気にかけている。
ーー
自分がVBAコードの相当な判定者のように思っているようだが、質問者はそこまで考えたたか？

お礼

検証までしていただいて、何度ものご指摘ありがとうございます。

実際には自動実行である必要は全くなく、リストに時々の文字列を入力し
＞シートに「着色」のVBA実行ボタンを配置して・・・
が当方には使いやすいのでそのようにして使う予定です。

また
＞自分がVBAコードの相当な判定者のように思っているようだが、質問者はそこまで考えたたか？
全く思っていませんし、そこまで考えていません。
タダご回答の中で、素人の当方にとっては非常に使いやすいVBAだと思っただけです。

回答No.9

kkkkkm

> No8さんのご回答が非常に使いやすく当方にとって汎用性が高いのでこちらをBSにさせて頂きますのでご了承ください。

はい、どの回答を採用しても自由なので気にしないでください。
ただ、「前方一致」と「部分一致」の違いは理解して質問してくださいね。

お礼

ハイ！アドバイスありがとうございます。
今後は気を付けたいと思います。

実際の表では前方一致なのですが、前方一致は部分一致に含まれる、＊を付ける場所を変えれば良いだけ、という認識でした。

やりたいことの内容の把握（当方の知識レベル）不足しているということだと思います。
長い目で見てやってください。（老い先短いですが・・）

kkkkmさんには過去にもお世話になったことが有ります。
これに懲りずに機会があれば今後とも宜しくお願いします。

回答No.7

kkkkkm

No.3No.4のおまけです。

先日、他の質問で「セルに色を付けたい」の後に、「文字に色を付けたい」に変更とかがあったのでおまけ追記しておきます。

そのような場合は
S.Interior.Color = F.Interior.Color
を
すべて文字の色の場合
S.Font.Color = F.Interior.Color
検索した文字だけ色付けの場合
S.Characters(1, Len(F.Value)).Font.Color = F.Interior.Color
に変更するだけで。

お礼

何度ものご丁寧なご回答に感謝！感謝！！

最初のご回答で何とか出来そうだったのですが、VBAに慣れていない途方にとって＃No8さんのご回答が非常に使いやすく当方にとって汎用性が高いのでこちらをBSにさせて頂きますのでご了承ください。

当方の実力を考慮した補足回答を含め、本当にありがとうございました。

回答No.6

imogasi

#2です。
VBAの経験があるかどうか、の補足も出ないうちに、どんどんVBAの回答が出ているが。
「前方一致」とは、セルの文字列の先頭に現れていると解して、調べて、やってみると，結構細部で難しかった。
「大きい」という語句（セルの文字列の、先頭部に来る条件で）でやって見た。
標準モジュールに
例　データ
A1:A10に
大きい川
口が大きい
大きな湖のほとり
大きい顔をして
湖の大きい波
大きい口を開ける
大きな湖
大きい川
被害が大きい
大きくなれば
と入れて下記を実行した。
＝＝＝
Sub Test01()
Range("a1:A10").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=FIND(""大きい"",A1)=1"
'Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
End With
'Selection.FormatConditions(1).StopIfTrue = False
End Sub
ーー
条件は先頭の「大きい」という語句。
結果は、
A列　１，４，６，８行に、セルの塗りつぶしの色が着いた。
ーー
もし使えるなら、対象セル範囲と語句を修正してやってみたら。
ただし、上記ではA2,AB、DXのそれぞれは、OR条件で式を組み立てられるかどうか
やって見てない。最悪では、語句ごとに繰り返しコードを作らないといけないかも。

お礼

ご指摘ありがとうございます。

＃No8さんのご回答で当方の想像以上の解決策が得られました。

回答No.5

kkkkkm

No.3No.4の補足です。

一致判定の部分は

InStr(1, S.Value, F.Value) = 1
でなくても、Likeを使って
S.Value Like F.Value & "*"
でもいけます。
最近InStr使う事が多かったので反射的にInStr使いました。

回答No.4

kkkkkm

No.3の追加です。

> リストに文字列を入力すると

というのが、入力したときに実行するという意味でしたら
リストの入力範囲がF2:F6として

その入力されたセルのみの文字列で検索

Private Sub Worksheet_Change(ByVal Target As Range)

If Application.Intersect(Target, Range("F2:F6")) Is Nothing Or Target.Value = "" Then
Exit Sub
End If

Dim S As Range, mRng As Range

Application.ScreenUpdating = False

Set mRng = Range("B5:C10")

For Each S In mRng
If InStr(1, S.Value, Target.Value) = 1 And Target.Value <> "" Then
S.Interior.Color = Target.Interior.Color
End If
Next

Application.ScreenUpdating = True

End Sub

上記を実行(最初に消さない場合)していれば意味のない動作だと思いますが
入力したセル以外も含めてF2:F6にある文字列を検索

Private Sub Worksheet_Change(ByVal Target As Range)

If Application.Intersect(Target, Range("F2:F6")) Is Nothing Or Target.Value = "" Then
Exit Sub
End If

Dim S As Range, F As Range, mRng As Range, LRng As Range

Application.ScreenUpdating = False

Set mRng = Range("B5:C10")
Set LRng = Range(Cells(2, "F"), Cells(Rows.Count, "F").End(xlUp))

For Each S In mRng
For Each F In LRng
If InStr(1, S.Value, F.Value) = 1 And F.Value <> "" Then
S.Interior.Color = F.Interior.Color
Exit For
End If
Next
Next

Application.ScreenUpdating = True

End Sub

なお、最初に選択したセルの色を消したい場合は以下のコードを最初に入れてください。
mRng.Interior.ColorIndex = xlNone
とかです。

回答No.3

kkkkkm

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

こちらか(都度コードを変更する)

Sub Test()
Dim S As Range, F As Range, mRng As Range, LRng As Range

Application.ScreenUpdating = False

Set mRng = Range("B5:C9")
Set LRng = Range(Cells(2, "F"), Cells(Rows.Count, "F").End(xlUp))

For Each S In mRng
For Each F In LRng
If InStr(1, S.Value, F.Value) = 1 And F.Value <> "" Then
S.Interior.Color = F.Interior.Color
Exit For
End If
Next
Next

Application.ScreenUpdating = True

End Sub

こちらか(利用者に範囲を選択させる)

Sub Test2()
Dim S As Range, F As Range, mRng As Range, LRng As Range

On Error Resume Next
Set mRng = Application.InputBox(Prompt:="検索対象範囲を選択してください。", Type:=8)
Set LRng = Application.InputBox(Prompt:="リストの範囲を選択してください。", Type:=8)
On Error GoTo 0

If mRng Is Nothing Or LRng Is Nothing Then
MsgBox "範囲選択が間違ってるかキャンセルされました", vbInformation
Exit Sub
End If

Application.ScreenUpdating = False

For Each S In mRng
For Each F In LRng
If InStr(1, S.Value, F.Value) = 1 And F.Value <> "" Then
S.Interior.Color = F.Interior.Color
Exit For
End If
Next
Next

Application.ScreenUpdating = True

End Sub

でしょうか。

お礼

当方の実力を考慮した色んな「忖度回答」ありがとうございました。

回答No.2

imogasi

後続の回答者などのために、補足を勧める。

＞コード中で指定出来れば
コードとは、VBAの（スクリプトの）コードですか？
質問者はVBAを、少しはやった経験があるのか？
会社は使用を許すのか？
仕事でエクセルを使い、珍奇な課題を持ち込むと、まずはVBAでできないかということになるのが常。
　思うには、こういう複数色の設定など必須か？色の判別はむつかしいし、逆に意味の導出も簡単でもないだろう。例　黄色は何の意味だったけ？
ーー
エクセルの操作で、「条件付き書式」で、条件を関数で指定する場合は、
エクセルの条件付き書式でセルに色を付ける場合、条件によって、別の色を付けるのは、色ごとに、複数の設定をしないといけない。
それでも質問者のやっている操作（質問文で、現在どうしているか、説明がないようで、おかしい。質問では、条件付書式という語句も出てきてない。現在よりも楽であれば、それ（操作による設定）を使えばよいのでは。
昔は、設定色は３色までだったが、いまのバージョンなら、制約ははずれ、10以上でも設定できるだろう。
＞シートによってマチマチ
手数的に、いやになる要素だ。
VBAでやるにしても、一元化は難しそう。
ーーー
「リスト」という言葉は、適当に使ってほしい。
条件となる文字列は、複数あり、同列の複数セル（セル範囲）にに集まっている、だけだろう。
コンピュターの用語の場合、入力規則のリストとか、リストボックスとか（他言語のリスト）特別な意味を持たされるのが現状で、本件では標題を読んで、身構えたが、実は、文字列が複数あり、各文字列は各セルに並んでいる、というぐらいの意味のようだな。

お礼

ご指摘ありがとうございました。
今後の参考にさせて頂きます。