Excel VBA 質問スレッド No.31 (未解決)

カレンダーの土日・祝該当列を塗りつぶし、開始日~終了日及び納期日をマクロで塗りつぶし

投稿者 : マクロ勉強中     投稿日時 : 2017/05/19(Fri) 07:43:58     OS : Windows 7     EXCEL : Excel 2013
マクロで予定表を作成しようと思っています。

作業開始日:N12~N100
作業終了日:O12~O100
納期日:P12~P100
カレンダー日付:T9~GB9
カレンダー曜日:T11~GB11

上記のような各項目日付となっており、
まず開始日と終了日を入力したら、開始日・終了日が記入されてる行でカレンダー日付の該当箇所を塗りつぶしたいと思っています。
また、納期日も色を付けたいので、開始日~終了日と納期日は別の色で付けたいと考えています。
ただし、土日、祝日は色つけたくないです。
(祝日は一覧で別シートに作成し、祝日リストの範囲を祝日と名前の定義をしています。)

まずは上記を行えるマクロを作成したいです。

また、カレンダーの土日・祝日に該当する列は休日用の色を設定して塗りつぶしをしたいです。

上記の内容は基本的に条件つき書式であらかたできるのはわかっているのですが、
項目を増やしたりすると条件付き書式が増えたりするので、マクロで行いたいと思っています。

宜しくお願い致します。

[返信 1] Re : カレンダーの土日・祝該当列を塗りつぶし、開始日~終了日及び納期日をマクロで塗りつぶし
投稿者 : 管理人     投稿日時 : 2017/05/21(Sun) 22:11:49
マクロ勉強中とのことですが、
プログラムのどこがわからないのかを書くか、
ご自身で作成したコードを掲載するとかしてもらわないと
回答する側としてもアドバイスしずらいです。

質問者さんがvbaをどこまで理解しているのか、
どのようなプログラムをつくりたいのかがわからないので、
以下のプログラムは、あくまで私がつくりたいようにつくった一例になります。

なお、仕様のあいまいな箇所はこちらで適当に決めさせていただきました。

●追加仕様
1.作業対象シートは「予定表」という名前になっている
2.祝日は「祝日」シートのA1~A100列にある
3.作業開始日、作業終了日、納期日が同じ日に重なる場合、納期日>作業終了日>作業開始日の順で優先して色をつける

Sub sample()

Const COLOR_KAISI = vbYellow ' 開始日の背景色
Const COLOR_OWARI = vbGreen ' 終了日の背景色
Const COLOR_NOUKI = vbRed ' 納期日の背景色
Const COLOR_SYUKU = vbMagenta ' 土日・祝日の背景色


Dim wsYotei As Worksheet
Dim wsSyuku As Worksheet
Dim rngKaisi As Range
Dim rngOwari As Range
Dim rngNouki As Range
Dim rngYotei As Range
Dim rngSyuku As Range

Application.ScreenUpdating = False

Set wsYotei = Worksheets("予定表")
Set wsSyuku = Worksheets("祝日")

With wsYotei
Set rngKaisi = .Range("N12:N100") ' 開始日セル
Set rngOwari = .Range("O12:O100") ' 終了日セル
Set rngNouki = .Range("P12:P100") ' 納期日セル
Set rngYotei = .Range("T9:GB9") ' 予定表セル
End With

Set rngSyuku = wsSyuku.Range("A1:A100") ' 祝日セル


' ループ内で使用する変数
Dim c As Range
Dim d As Date

For Each c In rngYotei.Cells

' 念のため日付チェック
If IsDate(c.Value) Then

' 日付変換
d = CDate(c.Value)

' 色付け処理
If Weekday(d, vbMonday) >= 6 Then ' 土日チェック
c.Interior.Color = COLOR_SYUKU

ElseIf SearchDate(rngSyuku, d) Then ' 祝日チェック
c.Interior.Color = COLOR_SYUKU

ElseIf SearchDate(rngNouki, d) Then ' 納期日チェック
c.Interior.Color = COLOR_NOUKI

ElseIf SearchDate(rngOwari, d) Then ' 終了日チェック
c.Interior.Color = COLOR_OWARI

ElseIf SearchDate(rngKaisi, d) Then ' 開始日チェック
c.Interior.Color = COLOR_KAISI

Else
c.Interior.Color = xlNone ' 背景色クリア

End If

End If

Next

Application.ScreenUpdating = True

MsgBox "予定表を作成しました。", vbInformation

End Sub

' 日付検索用プロシージャ
Function SearchDate(pRng As Range, pDate As Date) As Boolean

SearchDate = False

Dim c As Range
For Each c In pRng.Cells
If CDate(c.Value) = pDate Then
SearchDate = True
Exit Function
End If
Next

End Function

スポンサード リンク
 
 
当掲示板について
返信入力フォーム
お 名 前  :
内  容   :
ステータス  : この質問を解決済みにする

認証コード  :
        キャプチャ画像


( 処理日時 : 2019-06-17 04:31:22 )

Page
Top