[[20240111151818]]　『VBAで代休発生と代休取得の集計』（つるいち）　ページの最後に飛ぶ

『VBAで代休発生と代休取得の集計』（つるいち）

VBA初心者です。Excelで勤務表を作成しており、代休の発生と取得状況を別シートに表示させたいです。関数であればINDEX等を用いれば可能かとは思いますが、VBAでの詳細な方法がいまいちわかりません。ご助力をよろしくお願いします。以下詳細です。

○勤務表は年度ごとに別ブックで作成しており、月ごとにシート分けしている。
（今回ブックをまたいでの操作は考えておりません）

○シートは4月～3月まであり、シートのオブジェクト名をSheet1～12まで順番につけている。また、Sheet13～15は祝祭日などを規定するため別で使用。

○勤務表シート構成は、2行目に日付（D2～AG2）、3行目に曜日(TEXT関数で2行目を参照)、C列に勤務者の名前が入っているが、4行を1つにセル結合して使用。4行目以降にシフト入力（午前と午後に分けており、午前は3行分をセル結合して使用するが分割されることもある。午後は単一セルだが、勤務があってもセル値の入力があったりなかったりする）。休日に出勤がない場合は空白セルであり、勤務がある場合は、何らかの文字がセルに入力されている(日勤、夜勤、出張など)。平日に代休を取得する場合は、対象者の午前枠に"代休"、午後枠にいつの代休かの日付が入っている。

○Sheet14で代休管理をしたい。イメージとしてはA列は2行をセル結合して勤務者名(例：A2,3：田中さん、A4,5：鈴木さん、A6,7：佐藤さん、・・・)、C列以降に各月(各シート)の勤務表から土日、祝祭日に出勤している日付を抽出し古い方から表示。該当の代休を取得していれば、下のセルに取得した日付を表示させ、取得していなければ空白にしたい。
田中さんが4/6、4/7、5/5の休日に出勤し、それぞれ4/9、4/11、5/13に代休を取得、佐藤さんが4/7、4/21、5/18に休日出勤し、4/7の代休のみ4/10に取得した場合のイメージは下のような感じです。

| A | B | C | D | E | F | G |
田中代休 4/6 4/7 5/5
　　取得 4/9 4/11 5/13
佐藤代休 4/7 4/21 5/18
　　取得 4/10

当方、方法は次のようなことが出来れば可能かと思うのですが、詳細な方法が思い浮かびません。
代休検索は、各シート勤務者毎に行を参照し、2行目の日付が土日または祝祭日設定されている日（勤務者×休日がクロスするセル）に文字が入力されていれば、2行目の値（日付）をSheet14のCセルから順に入れていく。
取得検索は、各シート勤務者毎に行を参照し、"代休"の文字がある場合、その下のセルの値(日付)を参照し、Sheet14の勤務者の代休欄にその日付がある場合、参照した値のあるセルの2行目の値を入力する。

わかりにくくてすみませんが、よろしくお願いします。

＜使用 Excel：Excel2016、使用 OS：unknown ＞

 こんな感じかな？

 ※下記マクロは、代休管理シートのシートモジュールに貼り付ける (つまり、標準モジュールにではない）
 ※祝日リストは"祝日"と名前定義してあるものとする

 Sub CompeLeave()
     Dim i As Long, k As Long, nRW As Long, nCL As Long, HolyD As Range, rAgr As Range
     Dim App As Application, workdayFlag
     Dim daysAry, daysOfMonth, agrRW, agrCL, staffName, msg As String

     Set App = Application
     App.ScreenUpdating = False

     Me.UsedRange.Clear
     Set rAgr = Range("A1:B1")
     rAgr = Array("氏名", "区分")
     Set HolyD = App.Range("祝日")

     For i = 1 To 12 '4月(i=1) ～3月(i=12）
         With Worksheets((i + 2) Mod 12 + 1 & "月")
             daysOfMonth = Day(App.EoMonth(.Range("D2"), 0))
             daysAry = .Range("D2").Resize(1, daysOfMonth).Value2
             workdayFlag = App.NetworkDays(daysAry, daysAry, HolyD) '平日=1

             For nRW = 4 To .Cells(.Rows.Count, "C").End(xlUp).Row Step 4 '4行目の氏名からチェックする
                 For k = 1 To UBound(workdayFlag) '当月の初日から末日までチェックする
                     nCL = k + 3 '各シートの日付データは4列目から
                     staffName = .Cells(nRW, 3)

                     '氏名が初出かチェック
                     agrRW = App.Match(staffName, rAgr.Columns(1), 0)

                     If IsError(agrRW) Then '初出の場合
                         agrRW = rAgr.Rows.Count + 1
                         Cells(agrRW, 1).Resize(2, 1).Merge
                         Cells(agrRW, 1) = staffName
                         Cells(agrRW, 2).Resize(2, 1) = [{"代休";"取得"}]
                         Set rAgr = rAgr.Resize(rAgr.Rows.Count + 2, 2) '2行単位
                     End If

                     If workdayFlag(k) = 0 Then
                         If App.CountIf(.Cells(nRW, nCL).Resize(3), "*?") Then
                             Cells(agrRW, Columns.Count).End(xlToLeft).Offset(, 1) = .Cells(2, nCL).Value
                         End If
                     ElseIf App.CountIf(.Cells(nRW, nCL).Resize(3), "代休") Then '代休取得があった場合
                         agrCL = App.Match(.Cells(nRW + 3, nCL), Rows(agrRW), 0) '対応する休日出勤日を検索

                         If IsNumeric(agrCL) Then
                             Cells(agrRW + 1, agrCL) = .Cells(2, nCL).Value
                         Else '対応日が無し
                             msg = msg & staffName & "の代休(" & .Cells(2, nCL) & ")" & vbCrLf
                         End If
                     End If
                 Next k
             Next nRW
         End With
     Next i

     Me.Activate
     App.ScreenUpdating = True

     If msg <> "" Then
         MsgBox "休日出勤日が不明" & vbCrLf & msg
     End If
 End Sub

（半平太） 2024/01/12(金) 16:03:14

半平太さん
詳細なコードありがとうございます。
早速入力してみたところ、理想通りの挙動をしてくれて感動しました！
もう少し機能追加したい部分があるんですが、自分でも考えて頑張ってみたいと思います。
ありがとうございました！

（つるいち） 2024/01/13(土) 20:40:33

コメント返信：

[ 一覧(最新更新順) ]

[[20240111151818]] 『VBAで代休発生と代休取得の集計』（つるいち） ページの最後に飛ぶ

[[20240111151818]]　『VBAで代休発生と代休取得の集計』（つるいち）　ページの最後に飛ぶ