EXCELでマクロの記録を繰り返して

Question

EXCELでマクロの記録を繰り返して重複した行は分かる範囲でまとめたのですが、もう少しまとめられないかと思っています。

withで、まとめられなくても、順番を入れ替えたらまとまるものとか、逆にまとめようが無いものとか教えて頂けたらと思います。
よろしくお願いします。

With Selection
        .Phonetics.Visible = False                     'フリガナ表示をオフに
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    With Selection
        .FormatConditions.Add Type:=xlExpression, Formula1:="=AND(NOT(ISBLANK($A3)),ISBLANK($L3))"
        .FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    End With
    With Selection.FormatConditions(1).Interior
        .Pattern = xlSolid
        .PatternColorIndex = 0
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
    With Selection
        .FormatConditions.Add Type:=xlExpression, Formula1:="=AND(NOT(ISBLANK($A3)),NOT(ISBLANK($D3)))"
        .FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .TintAndShade = 0
        .PatternTintAndShade = 0
        .Color = 5296274
    End With
    
    With Selection
        .FormatConditions.Add Type:=xlExpression, Formula1:="=AND(NOT(ISBLANK($A3)),ISBLANK($R3))"
        .FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent5
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False

end-u · Accepted Answer

シートを切替える度に設定し直す処理はかなり効率が悪いように思えるのですが、
そこはあまり突っ込まないようにします。
ただ、そのコードが"予約状況"シートであれば、シート保護で対応できるのでは？、という疑問はありますね。

以下、ざっくりコードで
Sub sample()
　　Worksheets("予約状況").Unprotect
　　With Range("A1:A2,B1:B2,C1:C2,D1:D2,E1:E2,F1:F2,G1:G2,H1:H2,I1:I2,J1:J2," & _
　　　　　　"K1:K2,L1:L2,M1:M2,N1:O1,P1:Q1,R1:S1,T1:U1,V1:W1,X1:Y1,Z1:AA1," & _
　　　　　　"AB1:AC1,AD1:AE1,AF1:AG1,AH1:AI1,AJ1:AK1,AL1:AM1,AN1:AO1")
　　　　.HorizontalAlignment = xlDistributed
　　　　.VerticalAlignment = xlCenter
　　　　.WrapText = False
　　　　.Orientation = 0
　　　　.AddIndent = True
　　　　.IndentLevel = 0
　　　　.ShrinkToFit = False
　　　　.ReadingOrder = xlContext
　　　　.MergeCells = True
　　End With

Rows.RowHeight = 25
　　Rows("1:2").RowHeight = 17

Range("A:F").Columns.AutoFit
　　Range("G:K").ColumnWidth = 8
　　Range("B:C,L:M").ColumnWidth = 21
　　Range("N:AN").ColumnWidth = 23
　　Range("O1,Q1,S1,U1,W1,Y1,AA1,AC1,AE1,AG1,AI1,AK1,AM1,AO1").ColumnWidth = 9
　　Range("AP1").ColumnWidth = 0.2
　　Range("AQ1", Cells(1, Columns.Count)).Columns.Hidden = True

With ActiveWindow
　　　　.FreezePanes = False
　　　　.Split = False
　　　　Application.Goto Range("A1"), True
　　　　.SplitColumn = 3
　　　　.SplitRow = 2
　　　　.FreezePanes = True
　　End With

'Range("A3").Activate
　　With Range("A3", Cells(Rows.Count, "AO"))
　　　　.Phonetics.Visible = False
　　　　.VerticalAlignment = xlCenter
　　　　.WrapText = False
　　　　.Orientation = 0
　　　　.AddIndent = False
　　　　.ShrinkToFit = False
　　　　.ReadingOrder = xlContext
　　　　.MergeCells = False
　　　　With .FormatConditions
　　　　　　.Delete
　　　　　　.Add(Type:=xlExpression, Formula1:="=AND(NOT(ISBLANK($A3)),ISBLANK($R3))").Interior.ThemeColor = xlThemeColorAccent5
　　　　　　.Add(Type:=xlExpression, Formula1:="=AND(NOT(ISBLANK($A3)),NOT(ISBLANK($D3)))").Interior.Color = 5296274
　　　　　　With .Add(Type:=xlExpression, Formula1:="=AND(NOT(ISBLANK($A3)),ISBLANK($L3))").Interior
　　　　　　　　.Color = 65535
　　　　　　　　.Pattern = xlSolid
　　　　　　End With
　　　　End With
　　End With
End Sub

基本、Selectなしで処理できます。
それに条件付書式を設定する範囲が決まっているなら、前レスでのR1C1形式での処理は必要ありません。
ただ、バージョン2007の場合はコメントアウトしている
'Range("A3").Activate
が必要です。アクティブセルの位置によって数式がずれてしまいます。
2010はその点が改善されているため必要ないです。

『答え合わせ』
別に上記コードが正解ではないです。
自分を含め利用者が理解できてメンテナンスし易く、
目的通り動いてくれるコードならそれで構わないと思いますよ。

end-u · Answer

>ここですが、該当ブック使用者が意図する・意図しないにかかわらず、必要な幅以下にしてしまった時に、
>：
>を入れていたのですが、折り返し介助を先にすれば、幅を30にする処理は必要無いのでしょうか。
そうですね。先に折り返しを解除すれば良いかと思います。
別に設定しても差し支えないとも思いますけれども。
処理する場合は全列ではなくて、A:F列で良いはずですね。
With Range("A:F")
　　.ColumnWidth = 30
　　.Columns.AutoFit
End With
G列以降は固定値と非表示に設定しますから。

>あと、使用者は複数人居り、使用パソコンも使用ソフト(OS/OFFICE)もバラバラです。..
という事であれば Range("A3").Activate は必要です。
または#1のコードで書いたR1C1形式での設定に変更するかですね。

"A3"指定に関しては、数式ではないので相対参照や絶対参照は関係ありません。
$つけてもエラーになりませんが無視されます。

また、ver2003もあるようなら、ThemeColorプロパティは2007で追加されたプロパティなので使えません。
変更する必要があります。

end-u · Answer

あ、失礼..
>With Range("A1:A2,B1:B2,C1:C2,D1:D2,E1:E2,F1:F2,G1:G2,H1:H2,I1:I2,J1:J2," & _
>　　　　"K1:K2,L1:L2,M1:M2,N1:O1,P1:Q1,R1:S1,T1:U1,V1:W1,X1:Y1,Z1:AA1," & _
>　　　　"AB1:AC1,AD1:AE1,AF1:AG1,AH1:AI1,AJ1:AK1,AL1:AM1,AN1:AO1")
>　　.HorizontalAlignment = xlDistributed
>　　.VerticalAlignment = xlCenter
>　　.WrapText = False
>　　.Orientation = 0
>　　.AddIndent = True
>　　.IndentLevel = 0
>　　.ShrinkToFit = False
>　　.ReadingOrder = xlContext
>　　.MergeCells = True
>End With
これだとN2:AO2の書式設定が漏れますね。
結合時のエラー対策含めて..

With Range("A1:AO2")
　　.HorizontalAlignment = xlDistributed
　　.VerticalAlignment = xlCenter
　　.WrapText = False
　　.Orientation = 0
　　.AddIndent = True
　　.IndentLevel = 0
　　.ShrinkToFit = False
　　.ReadingOrder = xlContext
End With

Application.DisplayAlerts = False
Range("A1:A2,B1:B2,C1:C2,D1:D2,E1:E2,F1:F2,G1:G2,H1:H2,I1:I2,J1:J2," & _
　　　"K1:K2,L1:L2,M1:M2,N1:O1,P1:Q1,R1:S1,T1:U1,V1:W1,X1:Y1,Z1:AA1," & _
　　　"AB1:AC1,AD1:AE1,AF1:AG1,AH1:AI1,AJ1:AK1,AL1:AM1,AN1:AO1").MergeCells = True
Application.DisplayAlerts = True
：
こうかな。

end-u · Answer

Sub sample()

　　Dim ref As Long
　　ref = Application.ReferenceStyle
　　Application.ReferenceStyle = xlR1C1
　　If TypeName(Selection) <> "Range" Then Exit Sub
　　With Selection
　　　　.Phonetics.Visible = False　　 'フリガナ表示をオフに
　　　　.VerticalAlignment = xlCenter　'縦位置中央
　　　　.WrapText = False　　　　　　　'折り返し解除
　　　　.Orientation = 0　　　　　　　 '文字の向き
　　　　.AddIndent = False　　　　　　 'インデント解除
　　　　.ShrinkToFit = False　　　　　 '縮小表示解除
　　　　.ReadingOrder = xlContext　　　'文字読込み順解除（日本語では不要だと思う）
　　　　.MergeCells = False　　　　　　'結合解除
　　　　With .FormatConditions
　　　　　　.Delete　　　　　　　　　　'既設定の条件付書式を削除
　　　　　　.Add(Type:=xlExpression, Formula1:="=AND(NOT(ISBLANK(RC1)),ISBLANK(RC18))").Interior.ThemeColor = xlThemeColorAccent5
　　　　　　.Add(Type:=xlExpression, Formula1:="=AND(NOT(ISBLANK(RC1)),NOT(ISBLANK(RC4)))").Interior.Color = 5296274
　　　　　　.Add(Type:=xlExpression, Formula1:="=AND(NOT(ISBLANK(RC1)),ISBLANK(RC12))").Interior.Color = 65535
　　　　End With
　　End With
　　Application.ReferenceStyle = ref
End Sub

..こんな感じで良いかと思われます。
.WrapTextなどの書式設定の箇所は、既に設定されていたらそれを解除するコードなので、
考慮する必要が無い新規シートなどでは割愛できます。
コードを実行する作業環境に合わせて判断してください。

.FormatConditions.Delete は既に条件付書式が設定されていたらそれを削除するコードです。
既設定を生かして条件を常に追加する場合は .Delete は削除してください。

元コードの.SetFirstPriority は優先順位を１番目にする設定ですので、
最後に追加した条件の優先順位が高くなります。
逆に優先順位が高い順番に.Addすれば設定不要です。

.PatternColorIndex や .TintAndShade などは既定の設定だから不要と判断しましたが、
別途設定する必要がある時は
With .Add(Type:=xlExpression, Formula1:="=AND(NOT(ISBLANK(RC1)),ISBLANK(RC12))").Interior
　　.Color = 65535
　　.Pattern = xlSolid
End With
..のようにしてください。

.StopIfTrue = False「条件を満たす場合は停止」しない設定は、
今回の場合は.Interior（背景色）の設定のみで、実質効果がないので不要だと思われます。

さて。
Dim ref As Long
ref = Application.ReferenceStyle
Application.ReferenceStyle = xlR1C1
：
Application.ReferenceStyle = ref
この箇所がややこしいのですが...

実は『Selection』、つまりコード実行前に選択しているセルに対して設定する場合、
例えば10行目を選択して
.Add(Type:=xlExpression, Formula1:="=AND(NOT(ISBLANK($A3)),ISBLANK($R3))").Interior.ThemeColor = xlThemeColorAccent5
..とやってしまっていいものかどうか、という問題があります。
$A3、$R3、と指定されているという事は列固定で行は相対指定したいという事ですよね。
その場合、数式をR1C1形式で設定するという方法があります。
"=AND(NOT(ISBLANK($A3)),ISBLANK($R3))"
↓
"=AND(NOT(ISBLANK(RC1)),ISBLANK(RC18))"

2003以前のバージョンはこれで自動的にR1C1形式で指定されているんだな、とExcel君が判別してくれていたんですが
2007以降だと A1形式のRC列なのか、行相対でA列固定のR1C1形式なのか判別できません。
そこで
Dim ref As Long
ref = Application.ReferenceStyle
最初に、現在の列表示形式を変数refに控えておいて
Application.ReferenceStyle = xlR1C1
R1C1形式にして条件付書式を設定し、終わったら
Application.ReferenceStyle = ref
控えておいた元の形式に戻す処理をしてます。

もっとも、必ず3行目からセルを選択して実行する、という事が保証されるなら不要な処理ですが。
そのコードだけでは判断できませんので念のため入れました。

If TypeName(Selection) <> "Range" Then Exit Sub
..これも、セルではなく図形やグラフを選択して実行すればエラーになるので、その予防で念のため入れました。

EXCELでマクロの記録を繰り返して

シートを切替える度に設定し直す処理はかなり効率が悪いように思えるのですが、

>ここですが、該当ブック使用者が意図する・意図しないにかかわらず、必要な幅以下にしてしまった時に、

あ、失礼..

Sub sample()

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング