エクセル VBA 条件付き書式 簡略化したい

下記条件にてソースを書いていますが
簡略化したく
現状明細１行毎（16条件毎）に置換して追加する形で書いていますが

外部データ（CSV）からの取込で
データの順序が結構な間隔で変更されます。
その都度書き換えるとミスが発生しやすく
どうすれば良いかわかりません

Doを使っても上手く行きません

A B C D
1 01a 111 *** 001　A1白
2 02a 222 *** 002　A2ピンク
3 03a 333 *** 003　A3赤
4 01b 111 *** 001　A4白
5 02b 222 *** 002　A5ピンク
6 03b 333 *** 003　A6赤
全て文字列のデータです。

条件が12
データの行数が16行あります。

D1が001ならA1を白
D1が002ならA1をピンク
D1が003ならA1を赤

D2が001ならA2を白
D2が002ならA2をピンク
D2が003ならA2を赤


メインプログラムより抜粋

'条件付き書式セット

'シートプロテクト解除
ActiveSheet.Unprotect

'条件付き書式を削除　(指定範囲のみ）
Range("A1:D6").FormatConditions.Delete

'サブルーチン　コール

Call ZAI '条件付き書式_材質識別用


↓↓


Sub ZAI()
'条件付き書式　材質判別用


'宣言
Dim Con
Dim font1 As Font

'1行目
'001
Set Con = Range("$A$1").FormatConditions.Add(Type:=xlExpression, Formula1:="=$D$1=""001""")
Con.Interior.Color = RGB(255, 255, 255)
Con.Font.Color = RGB(0, 0, 0)
Con.StopIfTrue = False

'002
Set Con = Range("$D$1").FormatConditions.Add(Type:=xlExpression, Formula1:="=$D$1=""002""")
Con.Interior.Color = RGB(255, 192, 203)
Con.Font.Color = RGB(0, 0, 0)
Con.StopIfTrue = False

'003
Set Con = Range("$D$1").FormatConditions.Add(Type:=xlExpression, Formula1:="=$D$1=""003""")
Con.Interior.Color = RGB(255, 0, 0)
Con.Font.Color = RGB(0, 0, 0)
Con.StopIfTrue = False

　　........続く

'2行目
'001
Set Con = Range("$A$2").FormatConditions.Add(Type:=xlExpression, Formula1:="=$D$2=""001""")
Con.Interior.Color = RGB(255, 255, 255)
Con.Font.Color = RGB(0, 0, 0)
Con.StopIfTrue = False

'002
Set Con = Range("$D$2").FormatConditions.Add(Type:=xlExpression, Formula1:="=$D$2=""002""")
Con.Interior.Color = RGB(255, 192, 203)
Con.Font.Color = RGB(0, 0, 0)
Con.StopIfTrue = False

'003
Set Con = Range("$D$2").FormatConditions.Add(Type:=xlExpression, Formula1:="=$D$2=""003""")
Con.Interior.Color = RGB(255, 0, 0)
Con.Font.Color = RGB(0, 0, 0)
Con.StopIfTrue = False


..........続く

End SUB

質問者からの補足コメント

• 

  fujillin様
  KenKen_SP様
  
  ご親切にご回答頂きありがとうございました。
  添付したソースが間違っており
  混乱させてしまった事お詫び申し上げます。
  
  ちなみ　元データ（別シート）3000～5000行から
  指定した条件で最大16行摘出して処理していました。
  
  お陰様で無事処理でしました。

    補足日時：2022/06/03 10:02

No.1 ベストアンサー 回答者： fujillin 回答日時： 2022/06/02 18:20

こんばんは

ご提示のコードではD列に書式を設定してるみたいだし、内容も説明文とは違うので何だかよくわかりません。

＞条件が12
説明されている条件は3種類だけのように見えます。
さっぱりわからないけれど、「条件付き書式」にする必要があるのでしょうか？
どうせマクロを実行して終わりなら、直接セルの色を塗り替えても同じではないかと・・

よくわかりませんが、以下と仮定しました。
・D列の値に応じて、その行のA列の背景色を変える
・001の場合は白、002の場合はピンク、003の場合は赤
・それ以外が記されていませんが、色なしとする
・D列は必ず文字列に設定されている

以上の仮定で、直接A列の背景色を設定する例です。

Sub Sample()
Dim rw As Long, c As String

Range("A:A").Interior.Color = xlNone
For rw = 1 To Cells(Rows.Count, 4).End(xlUp).Row
c = Cells(rw, 4).Text
If c = "001" Then Cells(rw, 1).Interior.Color = rgbWhite
If c = "002" Then Cells(rw, 1).Interior.Color = rgbPink
If c = "003" Then Cells(rw, 1).Interior.Color = rgbRed
Next rw
End Sub

この回答へのお礼

ご回答ありがとうございます。

貼り付けたソース間違えおりました。

お礼日時：2022/06/03 09:29

No.2 回答者： KenKen_SP 回答日時： 2022/06/02 19:29

こんにちは。

#1と同感ですが、条件付き書式ならこんな感じ。
絶対参照と相対参照に気をつけて。
後はまとめて Excel まかせちゃって OK かと。
条件式は Excel が適切にやってくれます☆

Sub testProc()

　　Dim fc　　 As FormatCondition
　　Dim target As Range
　　
　　Set target = ActiveSheet.Range("A1:D16")
　　' ↑D列だけなら次行のように
　　Set target = ActiveSheet.Range("D1:D16")
　　
　　' 一度条件付き書式をクリアします
　　target.FormatConditions.Delete

　　Set fc = target.FormatConditions.Add(Type:=xlExpression, _
　　　　　　　　　　　　　　　　　　　　 Formula1:="=$D1=""001""")
　　fc.Interior.Color = RGB(255, 255, 255)
　　
　　Set fc = target.FormatConditions.Add(Type:=xlExpression, _
　　　　　　　　　　　　　　　　　　　　 Formula1:="=$D1=""002""")
　　fc.Interior.Color = RGB(255, 192, 203)
　　Set fc = target.FormatConditions.Add(Type:=xlExpression, _
　　　　　　　　　　　　　　　　　　　　 Formula1:="=$D1=""003""")
　　fc.Interior.Color = RGB(255, 0, 0)

End Sub

この回答へのお礼

色々と勉強になります。
今回はfujillin様ご指摘のように
条件付き書式を使わずに
都度処理を動かすようにいたしました。

お礼日時：2022/06/03 09:58