横型カレンダー　土日・祝日を判定して色を列につけたい

投稿者 : けろ     投稿日時 : 2024/08/10(Sat) 17:36:02     OS : Windows 10     EXCEL : Excel 2013

---

ガントチャート用横型カレンダーを作っています。
2行目に日、3行目に曜日が右にずらずらと入っています。
１か月分とかではなく、注文が入った日まで日を伸ばしますので最大列は変わりそうです。

2行目の文字が土の列2:3行目に青、4行目から50行目までは薄グレー
2行目の文字が日の列の2:3行目に赤、4行目から50行目までは薄グレー
祝日シートのA列に入っている日の列は2:3行目を橙、4行目から50行目までは薄グレー

としたいです。
縦型のカレンダーばかりで横に判定していくものがなく困っております。
何卒よろしくお願いいたします。

投稿者 : さんこう     投稿日時 : 2024/08/10(Sat) 17:49:37

---

＞縦型のカレンダーばかりで横に判定していくものがなく困っております。

縦でみ横でもたいして変わらないと思いますが。

参考になれば。

＜vba カレンダー 横型＞
https://www.google.com/search?q=vba+%E3%82%AB%E3%83%AC%E3%83%B3%E3%83%80%E3%83%BC+%E6%A8%AA%E5%9E%8B

投稿者 : けろ     投稿日時 : 2024/08/10(Sat) 21:17:42

---

ありがとうございます。
祝日の色塗りは一旦置いといて、土日の色塗りはできましたが、
Resize(,999)のところで999というふうにせず、最大列のところまでというふうに変数にしたいです。
どう記述したらよいでしょうか。

Sub 土日色塗り()
  
  Dim A
  For Each A In Range("B3").Resize(, 999)
    If Format(A, "aaa") = "日" Then
      '日曜日を塗りつぶし
      A.Offset(-1, 0).Resize(2).Interior.Color = RGB(252, 228, 214)
      A.Offset(1, 0).Resize(50).Interior.Color = RGB(242, 242, 242)
    ElseIf Format(A, "aaa") = "土" Then
      '土曜日を塗りつぶし
      A.Offset(-1, 0).Resize(2).Interior.Color = RGB(221, 235, 247)
      A.Offset(1, 0).Resize(50).Interior.Color = RGB(242, 242, 242)
    End If
  Next
  
End Sub

■[返信 1] さんこうさん（2024-08-10 17:49:37）の記事
＞ ＞縦型のカレンダーばかりで横に判定していくものがなく困っております。
＞
＞ 縦でみ横でもたいして変わらないと思いますが。
＞
＞ 参考になれば。
＞
＞ ＜vba カレンダー 横型＞
＞ https://www.google.com/search?q=vba+%E3%82%AB%E3%83%AC%E3%83%B3%E3%83%80%E3%83%BC+%E6%A8%AA%E5%9E%8B
＞
＞

投稿者 : さんこう     投稿日時 : 2024/08/10(Sat) 22:13:32

---

＞最大列のところまでというふうに変数にしたいです

999で不都合があるとも思えませんが、参考になれば。

https://www.google.com/search?q=vba+%E6%9C%80%E7%B5%82%E5%88%97+%E5%8F%96%E5%BE%97

投稿者 : けろ     投稿日時 : 2024/08/10(Sat) 22:53:30

---

祝日コードも何とか作ってみましたが処理が重くてどう縮めて良いかわかりません。
祝日シートのA列に縦に羅列されたデータリストにガントチャートシートにある横型カレンダーの日が一致したら、色を付けています。
ガントチャートシート２行目（日にち）と３行目（曜日）はサーモンピンクで、４行目から５３行目まではグレーにしています。

処理が重すぎるので軽くしたいです。

Sub 祝休日判定()

   Dim lastcolumn_1, lastrow_2, checkCode As Integer
   Dim targetDate As Date
   Dim i, j, k, t As Long
   Dim ws_1, ws_2 As Worksheet
   
    Set ws_1 = Worksheets("ガントチャート")
   Set ws_2 = Worksheets("祝日")
   
   lastcolumn_1 = ws_1.Cells(2, Columns.Count).End(xlToLeft).Column
   lastrow_2 = ws_2.Cells(Rows.Count, 1).End(xlUp).Row
   
   For i = 2 To lastcolumn_1
       targetDate = ws_1.Cells(2, i).Value
       checkCode = 0
       
       Application.ScreenUpdating = False
       
       For k = 2 To 3
       For j = 1 To lastrow_2
           If targetDate = ws_2.Cells(j, 1).Value Then
               checkCode = 1
               ws_1.Cells(k, i).Interior.Color = RGB(252, 228, 214)
            
           End If
       Next
       Next

       For t = 4 To 53
       For j = 1 To lastrow_2
           If targetDate = ws_2.Cells(j, 1).Value Then
               checkCode = 1
               ws_1.Cells(t, i).Interior.Color = RGB(242, 242, 242)
            
           End If
       Next
       Next

   Next
   
   Application.ScreenUpdating = True
   
End Sub

投稿者 : さんこう     投稿日時 : 2024/08/10(Sat) 23:40:43

---

＞処理が重くて

すべてのセルで祝日判定する必要はないです。

行の繰り返しは、祝日判定したあとにすればよろしいかと思います

投稿者 : けろ     投稿日時 : 2024/08/11(Sun) 07:49:54

---

ありがとうございます。
良いやり方かはわかりませんが、
以下のコードにしてかなり軽くなりました。
column側の変数もとりあえずやってみます。

Sub 祝日判定()

   Dim lastcolumn_1, lastrow_2, checkCode As Integer
   Dim targetDate As Date
   Dim i, j, k, t As Long
   Dim ws_1, ws_2 As Worksheet
   
   Set ws_1 = Worksheets("ガントチャート")
   Set ws_2 = Worksheets("祝日")
   
   lastcolumn_1 = ws_1.Cells(2, Columns.Count).End(xlToLeft).Column
   lastrow_2 = ws_2.Cells(Rows.Count, 1).End(xlUp).Row
   
   For i = 2 To lastcolumn_1
       targetDate = ws_1.Cells(2, i).Value
       checkCode = 0
       
       For j = 1 To lastrow_2
           If targetDate = ws_2.Cells(j, 1).Value Then
               checkCode = 1
                   For k = 2 To 3
                     ws_1.Cells(k, i).Interior.Color = RGB(252, 228, 214)
                          Next
                   For t = 4 To 53
                     ws_1.Cells(t, i).Interior.Color = RGB(242, 242, 242)
                   Next
           End If
       Next
    Next
   
End Sub

■[返信 5] さんこうさん（2024-08-10 23:40:43）の記事
＞ ＞処理が重くて
＞
＞ すべてのセルで祝日判定する必要はないです。
＞
＞ 行の繰り返しは、祝日判定したあとにすればよろしいかと思います
＞

投稿者 : ピロリ     投稿日時 : 2024/08/11(Sun) 07:50:26

---

ちなみに、　Dim lastcolumn_1, lastrow_2, checkCode As Integer　というのは、
　　　　　　Dim lastcolumn_1 As Variant, lastrow_2 As Variant, checkCode As Integer　ってこと。
変数 1つずつ宣言（As データ型）した方が良いと思います。

＞ 処理が重すぎるので軽くしたいです。
とは処理スピードが遅いということですか？　纏めて色替えすれば若干は速くなるかも･･･
「for test」の部分は、後で削除して下さい。

Sub 色替え()
    Dim start_time As Single    'for test
    Dim stop_time As Single     'for test
    start_time = Timer          'for test
    
    Dim ws_1 As Worksheet, ws_2 As Worksheet
    Dim lastcolumn_1 As Long, lastrow_2 As Long
    Dim checkCode As Integer
    Dim targetDate As Date
    Dim i As Long, j As Long
    
    Set ws_1 = Worksheets("ガントチャート")
    Set ws_2 = Worksheets("祝日")
    lastcolumn_1 = ws_1.Cells(2, Columns.Count).End(xlToLeft).Column
    lastrow_2 = ws_2.Cells(Rows.Count, 1).End(xlUp).Row
    
    Application.ScreenUpdating = False
    
    For i = 2 To lastcolumn_1
        checkCode = 0
        targetDate = ws_1.Cells(2, i).Value
        If Format(targetDate, "aaa") = "日" Then            '日曜日なら、
            checkCode = 1
            ws_1.Range(ws_1.Cells(2, i), ws_1.Cells(3, i)).Interior.Color = RGB(252, 228, 214)
        End If
        If Format(targetDate, "aaa") = "土" Then            '土曜日なら、
            checkCode = 1
            ws_1.Range(ws_1.Cells(2, i), ws_1.Cells(3, i)).Interior.Color = RGB(221, 235, 247)
        End If
        For j = 1 To lastrow_2
            If targetDate = ws_2.Cells(j, 1).Value Then     '祝日なら、
                checkCode = 1
                ws_1.Range(ws_1.Cells(2, i), ws_1.Cells(3, i)).Interior.Color = RGB(252, 228, 214)
            End If
        Next j
        If checkCode = 1 Then               '土・日・祝日のいずれかなら、
            ws_1.Range(ws_1.Cells(4, i), ws_1.Cells(53, i)).Interior.Color = RGB(242, 242, 242)
        End If
    Next i
    
    Application.ScreenUpdating = True
    
    stop_time = Timer                       'for test
    Debug.Print (stop_time - start_time)    'for test
End Sub

投稿者 : ピロリ     投稿日時 : 2024/08/11(Sun) 10:02:41

---

■[返信 7]（2024-08-11 07:50:26）の記事
33step目の処理後に、j ループを抜けていませんでした。
33step目と34step目の間に「 Exit For 」を追加して下さい。　すいません。

投稿者 : けろ     投稿日時 : 2024/08/11(Sun) 10:12:34

---

さんこう様　ピロリ様

ありがとうございます！！
できました！！！！
処理も早く記述もシンプルでわかりやすく、助かりました。
Exit forについてもありがとうございます！
変な記述を一生懸命理解していただき、感謝です。



■[返信 7] ピロリさん（2024-08-11 07:50:26）の記事
＞ ちなみに、　Dim lastcolumn_1, lastrow_2, checkCode As Integer　というのは、
＞ 　　　　　　Dim lastcolumn_1 As Variant, lastrow_2 As Variant, checkCode As Integer　ってこと。
＞ 変数 1つずつ宣言（As データ型）した方が良いと思います。
＞
＞ ＞ 処理が重すぎるので軽くしたいです。
＞ とは処理スピードが遅いということですか？　纏めて色替えすれば若干は速くなるかも･･･
＞ 「for test」の部分は、後で削除して下さい。
＞
＞ Sub 色替え()
＞ Dim start_time As Single 'for test
＞ Dim stop_time As Single 'for test
＞ start_time = Timer 'for test
＞
＞ Dim ws_1 As Worksheet, ws_2 As Worksheet
＞ Dim lastcolumn_1 As Long, lastrow_2 As Long
＞ Dim checkCode As Integer
＞ Dim targetDate As Date
＞ Dim i As Long, j As Long
＞
＞ Set ws_1 = Worksheets("ガントチャート")
＞ Set ws_2 = Worksheets("祝日")
＞ lastcolumn_1 = ws_1.Cells(2, Columns.Count).End(xlToLeft).Column
＞ lastrow_2 = ws_2.Cells(Rows.Count, 1).End(xlUp).Row
＞
＞ Application.ScreenUpdating = False
＞
＞ For i = 2 To lastcolumn_1
＞ checkCode = 0
＞ targetDate = ws_1.Cells(2, i).Value
＞ If Format(targetDate, "aaa") = "日" Then '日曜日なら、
＞ checkCode = 1
＞ ws_1.Range(ws_1.Cells(2, i), ws_1.Cells(3, i)).Interior.Color = RGB(252, 228, 214)
＞ End If
＞ If Format(targetDate, "aaa") = "土" Then '土曜日なら、
＞ checkCode = 1
＞ ws_1.Range(ws_1.Cells(2, i), ws_1.Cells(3, i)).Interior.Color = RGB(221, 235, 247)
＞ End If
＞ For j = 1 To lastrow_2
＞ If targetDate = ws_2.Cells(j, 1).Value Then '祝日なら、
＞ checkCode = 1
＞ ws_1.Range(ws_1.Cells(2, i), ws_1.Cells(3, i)).Interior.Color = RGB(252, 228, 214)
＞ End If
＞ Next j
＞ If checkCode = 1 Then '土・日・祝日のいずれかなら、
＞ ws_1.Range(ws_1.Cells(4, i), ws_1.Cells(53, i)).Interior.Color = RGB(242, 242, 242)
＞ End If
＞ Next i
＞
＞ Application.ScreenUpdating = True
＞
＞ stop_time = Timer 'for test
＞ Debug.Print (stop_time - start_time) 'for test
＞ End Sub
＞