指定した日付の範囲内でデータを検索したい

Question

エクセルのVBAを勉強中なのですがコードが分からないのでアドバイスをお願いします。
やりたいことは確認シートのE２とG2に入力された日付の範囲内で出勤した日数がE3とG3で入力された日数出勤してる人だけを抽出してそのシート名を確認シートのA2からA3・A4・・・と返したいです。以下書いてみたコードです。
これだと9月２８日から１０月４日に〇日出勤した場合と、１０月５日から１０月１１日に〇日出勤した人を別で抽出できないかなと思います。E2とG2で指定した日付の範囲内で対象のデータを抽出するにはどうしたらよいでしょうか。よろしくお願いします。
※1週間ごとに出勤した日数は計算されます。例えば、Aさんのシートの10/110/7まで欄にシフトを入力するとAさんのシートのJ9:J13の結合されたセルに勤務日数が返ります。
※第２週（10/810/14まで）のシフトを入力するとJ16:J20の結合セルに出勤日数が返ります
※Aさん以下B・C・D・・・と同じシートです。
※すべての人が同じサイクルで日付は書いてあります。例えばB9にはすべての人が9月28日の日付が入っていて以下B36まで連続した日付が並んでいてB36は10月25日になります。翌月にはB9は全員10月26日になりB36は11月22日になります。
以下の画像は左側が日付や出勤日数を指定する確認シートで右側が各個人のシートでAさん以下全員同じフォーマットを使用しています。

Sub 出勤日数()

Dim i As Long
Dim keyword As String
Dim lastrow As Long

keyword = Worksheets("確認").Cells(3, 5).Value
For i = 1 To Worksheets.Count
If Worksheets(i).Name <> "確認" Then
For 日付行1 = 9 To 36
If Worksheets(i).Cells(日付行1, 10).Value = keyword Then
Worksheets("確認").Activate
lastrow = Worksheets("確認").Cells(Rows.Count, 1).End(xlUp).row
Worksheets("確認").Cells(lastrow + 1, 1).Value = Worksheets(i).Name
End If
Next 日付行1
End If
Next i

End Sub

Comments

[kitasue]

[Aさん]シートに、月曜～日曜の１週間単位で日数が示されていますが、[確認]シートのセルE2に木曜日、G2に水曜日が指定されたら、日数はどう計算すればよいのでしょうか。

[syun0334]

［確認］シートのE2とG2に入る日付はそれぞれE2は毎週月曜の日付が入りG2は日曜の日付が入ります。［確認］シートB5:C7のセルに3/16基準とあるのですが毎年3/16の曜日を１週間の始まりの日にしています。2021/3/15までは月曜〜日曜が１週間となり2021/3/16〜2022/3/15までは火曜〜月曜が１週間となります。

Answer 1

次のコードでいかがでしょうか。

Sub 出勤日数()
    Dim i As Long
    Dim lngRow As Long
    Dim wshKkn As Worksheet
    Dim lngNss As Long
    
    Set wshKkn = Worksheets("確認")
    wshKkn.Range("A2").CurrentRegion.ClearContents
    
    For i = 1 To Worksheets.Count
        With Worksheets(i)
            If .Name <> "確認" Then
                lngNss = WorksheetFunction.SumIfs(.Range("J9:J36"), .Range("B9:B36"), ">=" & wshKkn.Range("E2").Value, .Range("B9:B36"), "<=" & wshKkn.Range("G2").Value)
                If lngNss >= wshKkn.Range("E3").Value And lngNss <= wshKkn.Range("G3").Value Then
                    wshKkn.Range("A2").Offset(lngRow).Value = .Name
                    lngRow = lngRow + 1
                End If
            End If
        End With
    Next i
    
End Sub

Comments

[syun0334]

早速のお返事ありがとうございます。頂いたコードを実行してみたのですが転記がされなかったです。エラーも特に出ていないので何が原因だかわからないので再度お願いしてもよろしいでしょうか。

[kitasue]

［確認］シートのE2やG2は、書式の表示形式が日付になってますでしょうか。
E3とG3の両方に数値が入っていますでしょうか。
[Aさん]のB9:B36の書式の表示形式は日付になってますでしょうか。

[syun0334]

両方に数値が入っていませんでした。解決しました。ありがとうございました。