『(マクロ)セルの作表方法について』（マイン）

お世話になっております。

日曜日のあるセルを取得し「5行目:7行目」と「60行目」に着色する方法について
Unionを使用した記述方法についてアドバイスをお願いいたします。

下記コードは

ActiveSheet内の勤務表を祝祭日に応じて罫線と着色をおこなうものです。

・5行目のカレンダー日付部分から日曜日を判別
　→日曜日の右側に罫線を引く(日と月の区切りがわかりやすくするため)
・5行目のカレンダー日付がマスタ内の休日リストに該当したら1行目の作業セルに関数で「1」を表示させ
　→その休日のある列に着色

上記について、ループで対象となるセルをUnionで格納して一気に作表させております。


現在のコードでは、5行目から90行目までの連続した範囲を指定していますが

冒頭にあるように、範囲を2つにして「5行目:7行目」と「60行目」としたく模索中です。

※Unionを使用しているのは処理速度が速かったため使用しています。
※セルの条件付き書式は、都合上あえて使用していません。


皆様アドバイスの程よろしくお願いいたします。



Sub カレンダー作表()

    With ActiveSheet
        '★最終列取得
        Dim col As Long    'カレンダーの最終列定数
        'AJ=4行目の36列目から左に検索（4行目には曜日番号がある）
        For col = .Cells(4, 36).End(xlToLeft).Column To 1 Step -1
            'セルを順次左方向に値が""以外のセルに到達したら終了
            If .Cells(4, col) <> "" Then Exit For
        Next col
        '★着色と罫線の初期化
        With .Range("E5:AI90")
            .Borders(xlInsideVertical).Weight = xlHairline    '極細
            .Interior.ColorIndex = 0    '無色
        End With

        '★作表範囲の取得

        Dim MyColor As Range    '着色:休日セルに着色
        Dim MyKei As Range    '罫線:日曜右セルに設置
        Dim c As Long 
        For c = 5 To col    '列5列目〜31列目まで処理　行固定（公休判断行は5行目）

            '★カレンダーから日曜日を判定し罫線を設置
            If Weekday(.Cells(5, c)) = vbSunday Then
                If MyKei Is Nothing Then    '※Unionに番地を格納
                    Set MyKei = .Range(.Cells(5, c), Cells(90, c))
                Else
                    Set MyKei = Application.Union(MyKei, .Range(.Cells(5, c), Cells(90, c)))
                End If
            End If

            '★公休着色:作業行1行目にある日付関数で休日マスタから休み該当=1表示を取得し処理
            If .Cells(1, c) = 1 Then
                If MyColor Is Nothing Then
                    Set MyColor = .Range(.Cells(5, c), Cells(7, c))
                Else
                    Set MyColor = Application.Union(MyColor, .Range(.Cells(5, c), Cells(7, c)))
                End If
            End If
        Next c
    End With

    Application.ScreenUpdating = False

    '★上記から処理判定し実際に作表

    If MyKei Is Nothing Then Exit Sub
    With MyKei
        .Borders(xlEdgeRight).Weight = xlThin   '細
    End With
    If MyColor Is Nothing Then Exit Sub
    With MyColor
        .Interior.ColorIndex = 36    'うす黄色
    End With

    Application.ScreenUpdating = True
End Sub



＜ 使用 Excel：Office365、使用 OS：Windows10 ＞
----
＞範囲を2つにして「5行目:7行目」と「60行目」としたく模索中
            If MyColor Is Nothing Then
                    Set MyColor = .Range(.Cells(5, c), Cells(7, c))
                Else
                    Set MyColor = Application.Union(MyColor, .Range(.Cells(5, c), Cells(7, c)))
                End If
            End If

↑に60行目も加えればいいでしょう。

あと、With ActiveSheet なので問題はでませんが、
 .Range(.Cells(5, c), Cells(7, c))
     ↓
 .Range(.Cells(5, c), .Cells(7, c))

を推奨します。

（もこな２） 2019/06/25(火) 08:49
----
もなこ2さん

ご指摘ありがとうございました

「.」抜けていました。単純なミスです。


60行目も加える方法ですが

Set MyColor = .Range(.Cells(5, c), Cells(7, c))
Set MyColor = MyColor & .Cells(60,c)

Else

ということでしょうか？
見当違いのこと言っていたらすみません。

（マイン） 2019/06/25(火) 09:15
----
なんか公国みたいなニックネームになってますがとりあえず・・

（１）
＞見当違いのこと言っていたらすみません。 
そんなこと書くらいなら、まずは自分でテストしてみてはどうでしょうか？
    Sub test()

        Dim MyRNG As Range

        Set MyRNG = Range("A1:D2")
        Set MyRNG = MyRNG & Range("A60:D60")

        Debug.Print MyRNG.Address(0, 0)

    End Sub

【−−以下は、自分で上記コードをテストしてみてから読んでください−−】


（１）のつづき
Unionメソッドを理解されているならこうすればよいことに気づけるはずです。
    Sub test()

        Dim MyRNG As Range

        Set MyRNG = Range("A1:D2")
        Set MyRNG = Union(MyRNG, Range("A60:D60"))

        Debug.Print MyRNG.Address(0, 0)

    End Sub

なお、「※Unionに番地を格納」とコメントをつけていますが、番地（アドレス）ではなく、Union【メソッド】を使って、【オブジェクト型の変数】に複数の「セル（範囲）」そのものを格納しています。


（２）
「.」を忘れたのは単純ミスとのことですが、質問の形式で追加提示されたものも抜けてますよ。

（３）
このほか↓の部分について
    If MyKei Is Nothing Then Exit Sub
    With MyKei
        .Borders(xlEdgeRight).Weight = xlThin   '細
    End With
    If MyColor Is Nothing Then Exit Sub
    With MyColor
        .Interior.ColorIndex = 36    'うす黄色
    End With

「MyKei」がNothingで、「MyColor」がNothingでなかったらどうするんですか？
 ※流し読みしたので、私が見落としているだけで、もともと「MyKei」がNothingになる場合は「MyKei」もNothingになる
   設計になっているのでしたら、余計なツッコミごめんなさい。

ちなみに、私ならWithステートメントを使う意味もなさそうですし、このようにします。    
    If Not MyKei Is Nothing Then
        MyKei.Borders(xlEdgeRight).Weight = xlThin     '細
    End If
    If Not MyColor Is Nothing Then
        MyColor.Interior.ColorIndex = 36    'うす黄色
    End If

（４）
どうでもよいツッコミですが、
「ColorIndex = 36    'うす黄色」
カラーパレットの36番目が【うす黄色】であるかは環境（設定）に依存しますから、確実にうす黄色にしたいなら、ちゃんと指定した方が安心かなぁとおもいます。
http://officetanaka.net/excel/vba/graph/24.htm

（もこな２） 2019/06/25(火) 12:07
----
もこな2　さん

アドバイスありがとうございます。

Set MyColor = .Range(.Cells(5, c), Cells(7, c)) 
Set MyColor = MyColor & .Cells(60,c) 

エラーになりました。

アドバイスを元に以下の通り修正したら

・色設定の箇所
・色の曖昧な設定をやめてRBGで設定

以上を修正したら思い通りの動作が可能となりました。

感謝申し上げます。


手動計算・描画停止を入れても

条件付き書式に比べて一瞬ですが
もっさりとした動きは仕様上目をつぶるしかなさそうです。




Sub カレンダー作表()
    With ActiveSheet
        '★最終列取得
        Dim col As Long    'カレンダーの最終列定数
        'AJ=4行目の36列目から左に検索（4行目には曜日番号がある）
        For col = .Cells(4, 36).End(xlToLeft).Column To 1 Step -1
            'セルを順次左方向に値が""以外のセルに到達したら終了
            If .Cells(4, col) <> "" Then Exit For
        Next col
        '★着色と罫線の初期化
        With .Range("E5:AI90")
            .Borders(xlInsideVertical).Weight = xlHairline    '極細
            .Interior.ColorIndex = 0    '無色
        End With
        '★作表
        Dim MyColor As Range    '公休の着色
        Dim MyKei As Range    '日曜右セルに罫線
        Dim c As Long    'カレンダー行カウント用変数
        For c = 5 To col    '列5列目〜31列目まで処理　行固定（公休判断行は5行目）
            '★カレンダーから日曜日を判定し罫線を設置
            If Weekday(.Cells(5, c)) = vbSunday Then
                If MyKei Is Nothing Then    '※Unionに番地を格納
                    Set MyKei = .Range(.Cells(5, c), .Cells(90, c))
                Else
                    Set MyKei = Application.Union(MyKei, .Range(.Cells(5, c), Cells(90, c)))
                End If
            End If
            '★公休着色:作業行1行目にある日付関数で休日マスタから休み該当=1表示を取得し処理
            If .Cells(1, c) = 1 Then
                If MyColor Is Nothing Then
                    Set MyColor = .Range(.Cells(5, c), .Cells(7, c))
                    Set MyColor = Application.Union(MyColor, .Range(.Cells(60, c), Cells(60, c)))
                Else
                    Set MyColor = Application.Union(MyColor, .Range(.Cells(5, c), Cells(7, c)))
                    Set MyColor = Application.Union(MyColor, .Range(.Cells(60, c), Cells(60, c)))
                End If
            End If
        Next c
    End With
    Application.ScreenUpdating = False  '描画停止
    Application.Calculation = xlCalculationManual  '手動計算
    '処理判定し実際に作表
    If Not MyKei Is Nothing Then
        MyKei.Borders(xlEdgeRight).Weight = xlThin   '細
    End If
    If Not MyColor Is Nothing Then
        MyColor.Interior.Color = RGB(255, 167, 255)  'うすめピンク
    End If

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

（マイン） 2019/06/26(水) 08:37
----
（５）
繰り返しになりますが、気になるのであえてツッコミます。
With ActiveSheet なので問題は出ませんが、Cellsの前の「.」忘れが多数存在します。

（６）
よくわかりませんが、↓って該当列の1行目が「1」になってるってことですか？
'★公休着色:作業行1行目にある日付関数で休日マスタから休み該当=1表示を取得し処理

（７）
やってることとコメントが一致してません。
コメントのとおりだとすると処理の対象は【E〜AE列の固定】ではないですか？
    For col = .Cells(4, 36).End(xlToLeft).Column To 1 Step -1
        'セルを順次左方向に値が""以外のセルに到達したら終了
        If .Cells(4, col) <> "" Then Exit For
    Next col
    For c = 5 To col    '列5列目〜31列目まで処理　行固定（公休判断行は5行目）
        '（中略）
    Next c

ただ、初期化？しているのは、【E〜AI列の固定】になってますね
    With .Range("E5:AI90")
        .Borders(xlInsideVertical).Weight = xlHairline    '極細
        .Interior.ColorIndex = 0    '無色
    End With

（８）
＞エラーになりました。
なるでしょうね。聞く前に試せばわかることですから、デバッグ作業や検証は人任せにせず、ご自身でちゃんとやるべきですよ。
ただ、そんなことより重要なのは、なんでエラーになったかは解るのでしょうか？
 もっと言うと、なんで言ったとおりに直したらエラーにならなくなったのか理解されてますか？
（たぶん型が一致しないというエラーが出たと思いますが、原因はそのまま、Range型の変数にそうでないものをぶち込むようにしていたためと思われます。）
（エラーの種類が違っていたらごめんなさい。）

（９）
＞手動計算・描画停止を入れても 条件付き書式に比べて一瞬ですが 
＞もっさりとした動きは仕様上目をつぶるしかなさそうです。 
言いたいことがよくわかりません。

条件付き書式の方が早いと言いたいなら、まぁそうかもしれないですね。
マクロの方は、実行の度にイチからチェックしてから、書式をいじってますから・・
改善案としては、Changeイベントなどを使って、5行目に入力があったらその列だけ処理するという感じにすればよいとおもいますが、そのようにする場合でも、まずはこちらのマクロを完成させてから応用した方が良さそうです。

ところで、なんで計算方法を手動にするんでしょうか？
書式しか変えてませんからそもそも再計算は発生しないようにおもいますので狙いがわかりません。

（もこな２） 2019/06/26(水) 18:53
----
もこな2　さん

ご面倒をおかけしてすみません。
ご指摘大変勉強になっております。


(5)の部分ですが「.」修正しました。
エラーがでていなかったもので､完全に見落としです｡

(6)の1行目の作業列は5行目の日付が別シートにある休日リスト(土日祝日一覧)の日付と一致した
関数で「1」を表示させています「E1=IF(ISNA(MATCH(E5,休日リスト,0)),"",1)・・・・AI1」

休日の着色は・・・下記の部分のコードで1行目を参照して「1」があれば休日と判断しています。
If .Cells(1, c) = 1 Then
    If MyColor Is Nothing Then
        Set MyColor = .Range(.Cells(5, c), .Cells(7, c))
        Set MyColor = Application.Union(MyColor, .Range(.Cells(60, c), .Cells(60, c)))
    Else
        Set MyColor = Application.Union(MyColor, .Range(.Cells(5, c), .Cells(7, c)))
        Set MyColor = Application.Union(MyColor, .Range(.Cells(60, c), .Cells(60, c)))
    End If
End If


日曜日の右側に罫線を引くのは・・・5行目のカレンダー行から日曜日を
 If Weekday(.Cells(5, c)) = vbSunday Then
 で判断しています｡
 
 
(7)の範囲設定ですが、言われるとおりです。
処理対象のセル範囲は固定です｡
他のマクロコードをそのままコピペして使いまわしていました｡
余計に処理時間を引き伸ばしていました｡

(8)は型が違うものを格納しようとしたことによるエラーメッセージでした。


(9)自動計算停止は、神頼み的に入れてしまいました。
よくよく考えると、再計算が必要な処理は休日判定で終わっているので意味がありませんでした。
（マイン） 2019/06/26(水) 23:43
----
(6)の返答の返答
聞きたかったのは、該当列の1行目が「1」になってるかどうかだったので、「はい」だけでよかったんですけど、聴き方がよくなかったですかね。
とりあえず確認したい点は解りました。

ただ、提示されたことを踏まえると「休日リスト」と名前をつけたセル範囲に土日分も含めてリストを作ったんですよね？
Office365と仰っているので、NETWORKDAYS関数というものを使うと、休日分だけ（いちいち土日分を含めない）のリストで対応できますよ
http://www.kenzo30.com/ex_kisotyu/ex_ks_tyukyu9_9_3.htm

 E1=NETWORKDAYS(E5,E5,休日リスト)
    E5が平日　    → 1
    E5が土日祝日　→ 0

もとのように 「""」or「1」としたければ、↓でも大丈夫だとおもいます。
 E1=IF(NETWORKDAYS(E5,E5,休日リスト),"",1)

また、返り値が論理値でも気にならないということであれば、↓でもよいですね【★1】
 E1=NOT(NETWORKDAYS(E5,E5,休日リスト))

(7)の返答の返答
＞言われるとおりです。 
で、実際の範囲はどっちなんですか？【★2】
【E〜AE列の固定】or【E〜AI列の固定】

(8)の返答の返答
＞型が違うものを格納しようとしたことによるエラーメッセージ
それ、もう私が言ってるじゃないですか・・・
肝心なのは、そのエラーメッセージが返ってきたときに「あっそっか〜間違っちゃった〜」と思って直すことができるのか（直す"方法"を覚える気があるのか）、そもそも自分で検証・修正する気は無くて、作成やデバッグ作業は無償で人にやってもらい完成品だけほしいのかどっちなんだろうということです。
 ※後者だとすると、このサイト的にNGではないようですが、私は請け負う気が無いので降りますから早めに言ってほしいです。

(9)の返答の返答
「神頼み」ってなんですか？
ScreenUpdatingも含めて、なんで高速化に寄与するのか調べ直した方がよいとおもいます。
（以前、おまじないと称して盲目的に付している方もいらっしゃいました。まぁ困りはしないのでしょうけど・・・）

また、個人的には、高速化は完成してからの話（無駄な動作の改善は別）だと思うのでScreenUpdating等は、トライ＆エラーを繰り返している段階では入れない方がよいとおもいます。【★3】

（次投稿に続きます…が、少し間が開くかもしれません）







（もこな２） 2019/06/28(金) 09:07
----
（もこな２） 2019/06/28(金) 09:07　の続きです

(10)
研究用にサンプルコードを提供します。
丸写しはしないで、ステップ実行して研究のうえ必要と思われる部分だけご自身のコードに組み入れてください。
 【★1】などの処置により対象列の1行目には[TRUE]か[0以外の"数値"]が、対象でない列の１行目には[FALSE]か[0]が入ってるものとします
 【★2】は【E〜AI列の固定】だとします
 【★3】のとおり、高速化は外しています。
 **-------------------------------------------------------------------**
    Sub さんぷる_いち()
        Dim MyRNG As Range
        Dim 表範囲 As Range
        Dim MyColor As Range    '着色:休日セルに着色
        Dim MyKei As Range    '罫線:日曜右セルに設置
        
        With ActiveSheet.Range("E1:AI90")
            With .Rows("5:90")
                Set 表範囲 = .Cells
                .Borders(xlInsideVertical).Weight = xlHairline    '極細
                .Interior.ColorIndex = 0    '無色
            End With
            
            '▼セルの日付が日曜日だったら「MyKei」に追加
            For Each MyRNG In .Rows(5).Cells
                If Weekday(MyRNG.Value) = vbSunday Then
                    If MyKei Is Nothing Then
                        Set MyKei = MyRNG
                    Else
                        Set MyKei = Union(MyKei, MyRNG)
                    End If
                End If
            Next
            
            '▼セルの値がTRUEだったら「MyColor」に追加
            For Each MyRNG In .Rows(1).Cells
                If MyRNG.Value Then
                    If MyColor Is Nothing Then
                        Set MyColor = MyRNG
                    Else
                        Set MyColor = Union(MyColor, MyRNG)
                    End If
                End If
            Next
            
            '▼書式の設定
            If Not MyKei Is Nothing Then
                Intersect(MyKei.EntireColumn, 表範囲).Borders(xlEdgeRight).Weight = xlThin  '細
            End If
            
            If Not MyColor Is Nothing Then
                Intersect(MyColor.EntireColumn, 表範囲).Interior.Color = RGB(255, 167, 255)  'うすめピンク
            End If
            
        End With
    
    End Sub
 **-------------------------------------------------------------------**
     Sub さんぷる_にー()
        Dim MyRNG As Range
        Dim 表範囲 As Range
        Dim MyColor As Range    '着色:休日セルに着色
        Dim MyKei As Range    '罫線:日曜右セルに設置
        
        With ActiveSheet.Range("E1:E90").Resize(, 31)
           '中略（「さんぷる_いち」と一緒 ）           
        End With
    
    End Sub
 **-------------------------------------------------------------------**
        Sub さんぷる_さん()
        Dim i As Long
        Dim MyColor As Range    '着色:休日セルに着色
        Dim MyKei As Range    '罫線:日曜右セルに設置
        
        With ActiveSheet
            With .Range("E5:AI90")
                .Borders(xlInsideVertical).Weight = xlHairline    '極細
                .Interior.ColorIndex = 0    '無色
            End With
        
            For i = 5 To 5 + 30
                
                '▼セルの値（日付）が日曜日だったら「MyKei」に追加
                If Weekday(.Cells(5, i).Value) = vbSunday Then
                    If MyKei Is Nothing Then
                        Set MyKei = .Cells(5, i)
                    Else
                        Set MyKei = Union(MyKei, .Cells(5, i))
                    End If
                End If
                
                '▼セルの値がTRUEだったら「MyColor」に追加
                If .Cells(1, i).Value Then
                    If MyColor Is Nothing Then
                        Set MyColor = Cells(1, i)
                    Else
                        Set MyColor = Union(MyColor, Cells(1, i))
                    End If
                End If
            Next i

            '▼書式の設定
            If Not MyKei Is Nothing Then
                Intersect(MyKei.EntireColumn, .Range("E5:AI90")).Borders(xlEdgeRight).Weight = xlThin  '細
            End If
            
            If Not MyColor Is Nothing Then
                Intersect(MyColor.EntireColumn, .Range("E5:AI90")).Interior.Color = RGB(255, 167, 255)  'うすめピンク
            End If
            
        End With
    
    End Sub

（もこな２） 2019/06/30(日) 13:10