ＶＢＡで条件付書式設定方法

質問

次の内容の件です

Dim wArray As Variant
Dim wI As Integer

' セルA3:K3の条件付書式設定 A3の設定：A3=B3は黒,A3<B3は緑,A3>B3は赤,以降同様に
wArray = Array(, "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L")

For wI = 1 To UBound(wArray) - 1
　　　Sheets("Sheet1").Cells(3, wI).Select
　　　Selection.FormatConditions.Delete
　　　Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$" & wArray(wI) & "3=$" & wArray(wI + 1) & "3"
　　　With Selection.FormatConditions(1).Font
　　　　　.Bold = False
　　　　　.Italic = False
　　　　　.ColorIndex = xlAutomatic
　　　End With
　　　Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$" & wArray(wI) & "3<$" & wArray(wI + 1) & "3"
　　　With Selection.FormatConditions(2).Font
　　　　　.Bold = False
　　　　　.Italic = False
　　　　　.ColorIndex = 10
　　　End With
　　　Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$" & wArray(wI) & "3>$" & wArray(wI + 1) & "3"
　　　With Selection.FormatConditions(3).Font
　　　　　.Bold = False
　　　　　.Italic = False
　　　　　.ColorIndex = 3
　　　End With
Next wI

実行時にアクティブセルにならないコーディング方法は？
また、もっと合理的な、シンプルな方法はないでしょうか？

いろいろと、やってみましたが、エラーとか行ズレとなり困っています
よろしくご教示ください

回答No.7

merlionXX · ベストアンサー

ANo1-6 merlionXXです。
ANo6のでも大丈夫と思いますが書き方に変なところがありましたので再修正します。

Sub test04()
　　Dim myC As Range
　　Set myC = ActiveCell
　　With Sheets("Sheet1").Range("A3:L3")
　　　　.Cells(1).Activate
　　　　.FormatConditions.Delete
　　　　.FormatConditions.Add Type:=xlExpression, Formula1:="=A3=B3"
　　　　With .FormatConditions(1).Font
　　　　　　.ColorIndex = xlAutomatic
　　　　End With
　　　　.FormatConditions.Add Type:=xlExpression, Formula1:="=A3<B3"
　　　　With .FormatConditions(2).Font
　　　　　　.ColorIndex = 10
　　　　End With
　　　　.FormatConditions.Add Type:=xlExpression, Formula1:="=A3>B3"
　　　　With .FormatConditions(3).Font
　　　　　　.ColorIndex = 3
　　　　End With
　　End With
　　myC.Activate
End Sub

お礼

ていねいにありがとうございました
ステップの違いを確認・テストしてマスターしていきます

回答No.6

merlionXX

> merlionさんのとおり実行しましたが、期待する結果が得られませんでした

失礼しました。
以下で再度お試しください。

Sub test03()
　　Dim myC As Range
　　Set myC = ActiveCell
　　With Sheets("Sheet1").Range("A3:L3")
　　　　.Range("A3").Activate
　　　　.FormatConditions.Delete
　　　　.FormatConditions.Add Type:=xlExpression, Formula1:="=A$3=B$3"
　　　　With .FormatConditions(1).Font
　　　　　　.ColorIndex = xlAutomatic
　　　　End With
　　　　.FormatConditions.Add Type:=xlExpression, Formula1:="=A$3<B$3"
　　　　With .FormatConditions(2).Font
　　　　　　.ColorIndex = 10
　　　　End With
　　　　.FormatConditions.Add Type:=xlExpression, Formula1:="=A$3>B$3"
　　　　With .FormatConditions(3).Font
　　　　　　.ColorIndex = 3
　　　　End With
　　End With
　　myC.Activate
End Sub

お礼

ありがとうございました
きれいで無理・無駄がありませんね
activate と select　を再認識し、なるほどと感じ入った次第です
いじくりでなく、基礎を確認することが大事なことがよくわかりました
たいへんお世話になりました

回答No.5

mitarashi

#2です。もうひとひねりしてみました。ご参考まで。

Sub test()
Dim formulaArray As Variant, colorArray As Variant
Dim i As Long

formulaArray = Array("=RC=RC[+1]", "=RC<RC[+1]", "=RC>RC[+1]")
colorArray = Array(xlAutomatic, 10, 3)
With Sheets("Sheet1").Range("A3:K3")
.FormatConditions.Delete
For i = 1 To 3
.FormatConditions.Add Type:=xlExpression, Formula1:=formulaArray(i - 1)
.FormatConditions(i).Font.colorIndex = colorArray(i - 1)
Next i
End With
End Sub

お礼

横を縦にしたようなものですね
恐れ入ります
ありがとうございました

回答No.4

Wendy02

私は、「合理的」とか良く分かりませんが、可読性を犠牲にするなら、アリかもしれません。ただ、こういうのは苦手です。

Sub ConditionPro1()
　Dim a As String, b As String
　With Worksheets("Sheet1").Range("A3").Resize(1, 12)
　　a = "=" & "RC": b = "RC[1]"
　　.FormatConditions.Delete
　　With .FormatConditions.Add(2, 0, a & "=" & b, 0)
　　　.Font.ColorIndex = xlAutomatic
　　End With
　　With .FormatConditions.Add(2, 0, a & "<" & b, 0)
　　　.Font.ColorIndex = 10
　　End With
　　With .FormatConditions.Add(2, 0, a & ">" & b, 0)
　　　.Font.ColorIndex = 3
　　End With
　End With
End Sub

お礼

ご回答ありがうございました
Wendy02さんの言われる可読性とシンプルが最優先ですね
私の提示したものは、「Ｆｏｒ文」しか頭になくそれで配列を
ほんとにコテコテですね
ご回答の引数形式は難解に感じる位ですから
今後もよろしくお願いします

回答No.3

tom04

こんばんは！
一例です

Sub test()
Range(Cells(3, 1), Cells(3, 12)).Font.ColorIndex = 0
Dim j As Long
For j = 1 To 11
If Cells(3, j) = Cells(3, j + 1) Then
Cells(3, j).Font.ColorIndex = xlAutomatic
ElseIf Cells(3, j) < Cells(3, j + 1) Then
Cells(3, j).Font.ColorIndex = 10
Else
Cells(3, j).Font.ColorIndex = 3
End If
Next j
End Sub

こんな感じではどうでしょうか？
的外れならごめんなさいね。m(__)m

お礼

ご回答ありがうございました
今回、各種の書式エリアにデータを何回も展開する環境でしたので
今後、利用していきたいと参考になりました
今後もよろしくお願いします

回答No.2

mitarashi

相対アドレスになってしまいますが、支障があるでしょうか？

Sub test()
With Sheets("Sheet1").Range("A3:K3")
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:="=RC=RC[+1]"
With .FormatConditions(1).Font
.Bold = False
.Italic = False
.ColorIndex = xlAutomatic
End With
.FormatConditions.Add Type:=xlExpression, Formula1:="=RC<RC[+1]"
With .FormatConditions(2).Font
.Bold = False
.Italic = False
.ColorIndex = 10
End With
.FormatConditions.Add Type:=xlExpression, Formula1:="=RC>RC[+1]"
With .FormatConditions(3).Font
.Bold = False
.Italic = False
.ColorIndex = 3
End With
End With
End Sub

お礼

ご回答ありがうございました
相対アドレスはなかなか使うことがありませんでした
すっきりしていて大変参考になりました
今回、相対アドレス利用関数を調べて勉強します
今後もよろしくお願いします

回答No.1

merlionXX

> もっと合理的な、シンプルな方法はないでしょうか？

Sub test02()
　　With Sheets("Sheet1").Range("A3:L3")
　　　　　.FormatConditions.Delete
　　　　　.FormatConditions.Add Type:=xlExpression, Formula1:="=A$3=B$3"
　　　　　With .FormatConditions(1).Font
　　　　　　　.ColorIndex = xlAutomatic
　　　　　End With
　　　　　.FormatConditions.Add Type:=xlExpression, Formula1:="=A$3<B$3"
　　　　　With .FormatConditions(2).Font
　　　　　　　.ColorIndex = 10
　　　　　End With
　　　　　.FormatConditions.Add Type:=xlExpression, Formula1:="=A$3>B$3"
　　　　　With .FormatConditions(3).Font
　　　　　　　.ColorIndex = 3
　　　　　End With
　　End With
End Sub

お礼

早速のご回答ありがとうございました
ほんの初心者で、基礎をマスターしないまま、知り得た知識をあっちこっち組み合わせて利用しているところです
プログラムをご覧になってお分かりのことと思います
　さて、ご親切なご回答にたいへん感謝いたしておりますとともに、各種方法があることにＶＢＡの多様性をつくづく感じ入るところです
　今後も機会があると思いますのでよろしくお願いします

merlionさんのとおり実行しましたが、期待する結果が得られませんでした
すっきりして無駄のないコーディングたいへん参考になりました
できましたら、ご検証のうえ再度お知らせいただきたいのですが
よろしくお願いします