エクセルVBAで、範囲内の決まった文字とその横に色をつけたい

質問

B4:AD27に表があり、そこにアルファベット(大文字)が振ってあります。それ自身とその左のセルに色をつけたいと考えています。
その色なのですが、一色ではなく。アルファベットにそれぞれ対応した色が指定してあります。(B1:O1に例えばB1にはAと文字があり赤になっています)
指定した色を変えていくことはVBAで可能でしょうか？

回答No.1

zap35 · ベストアンサー

＞VBAで可能でしょうか？
可能なんですけど、丸投げですか？

質問には曖昧なところが多いのですが、例えば
・色を変えるタイミングはセルに入力した時点？　それとも一括して処理？
・B1:O1に指定されている色は文字色？　それとも背景色？
・アルファベットは１文字のみ入力されている？　それとも先頭文字？
・大文字、小文字は混在していない？
・仮にB4セルに着色するとき、左のA4セル（表外）も着色してよい？
などです。

とりあえずマクロにしてみますが、修正はご自身で行ってくださいね。
以下のマクロをALT＋F11でVBE画面を開き、左上のVBA Projectでシート名を右クリックし「挿入」→「標準モジュール」で表示される画面に貼り付けて下さい。マクロの実行はワークシート画面に戻ってALT＋F8でマクロ一覧を開き、マクロ名を選択して「実行」ボタンです。

Sub Macro1()
Dim r, trg As Range
　For Each r In Range("B4:AD27")
　　If r.Value <> "" Then
　　　Set trg = Range("B1:O1").Find(what:=r.Value, LookIn:=xlValues, lookat:=xlWhole)
　　　If Not trg Is Nothing Then
　　　　r.Offset(0, -1).Resize(1, 2).Interior.ColorIndex = trg.Interior.ColorIndex
'　　　　r.Offset(0, -1).Resize(1, 2).Font.ColorIndex = trg.Font.ColorIndex
　　　End If
　　End If
　Next r
End Sub

上記マクロはセルの文字列が完全一致するとき、B1:O1の背景色で着色しています。文字色にするなら８行目のコメントにしている行をその上の行と差し替えてください

お礼

zap35さんありがとうございました。すばらしいものでした。
ありがとうございます。

回答No.2

merlionXX

色はフォントではなくセルですね？
こんな感じでしょうか。

Sub Test()
Dim c As Range, x As Range
With ActiveSheet
.Range("B4:AD27").Interior.ColorIndex = xlNone
For Each c In .Range("B4:AD27")
Set x = .Range("B1:O1").Find(What:=c.Value, LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
If Not x Is Nothing Then
c.Offset(0, -1).Resize(1, 2).Interior.ColorIndex = x.Interior.ColorIndex
End If
Next
End With
End Sub

お礼

merlionXXさんありがとうございます。試させていただきました。すばらしいものでした。短時間にこうやってできるの憧れです。
二方ともすばらしく甲乙つけがたいのですが、回等順ということにさせていただこうと考えるので次点とさせていただくのですが、同じように思っています。ありがとうございました。