エクセルのマクロを教えてください。

作業日報があります。
出勤していない人の日付を知りたいです。

当該月から今日までの間で
●●さんがこの日は出勤していないだねと、日付を知りたいです。

抜き出したいのは当該月ごとで、
例えば本日が5月15日とすると、5月1日から15日までの間とします。

日曜日や祭日は無視して抜き出してかまいません。

シート1の作業日報をシート2の形で抜き出したいです。

マクロコードを教えてください。
よろしくお願いします。

No.5 ベストアンサー 回答者： めぐみん_ 回答日時： 2020/05/01 10:55

No.2です。

初級者なのでちょっと長くなりました。
もっと短くかけるベテランさんのようなスキルが欲しい。

Sub megu()
Dim myDic As Object
Dim T_Day As Date, C_Date As Date, n As Integer
Dim r As Range, r2 As Range
Dim key1, key2, kintai As String

Set myDic = CreateObject("Scripting.Dictionary")
T_Day = DateSerial(2020, 4, 5) '★ダミーデータを作成 実際には = Date に。

With Worksheets("Sheet1") '★日報シート名に適宜修正
For Each r In .Range("B2", .Cells(Rows.Count, "B").End(xlUp))

If Not myDic.Exists(r.Value) Then myDic.Add r.Value, CreateObject("Scripting.Dictionary")
kintai = r.Value & "出"
If Not myDic(r.Value).Exists(kintai) Then myDic(r.Value).Add kintai, CreateObject("System.Collections.ArrayList")

myDic(r.Value)(kintai).Add (r.Offset(, -1).Value)

Next
End With

With Worksheets("Sheet2") '★書き出すシート名に適宜修正
Set r2 = .Range("B2")
For Each key1 In myDic.Keys
For Each key2 In myDic(key1).Keys

r2.Value = key1

If myDic(key1)(key2).Count > 0 Then
For n = 1 To Day(T_Day)
C_Date = DateSerial(Year(T_Day), Month(T_Day), n)
If myDic(key1)(key2).IndexOf_3(C_Date) = -1 Then Set r2 = r2.Offset(1): r2.Value = C_Date
Next
End If
Next

Set r2 = .Cells(2, r2.Column + 1)
Next
End With

Set myDic = Nothing
Set r2 = Nothing

End Sub

一応ＷＩＮ１０であり動かないようなら、
https://qwerty.work/blog/2019/09/windows10-netfx …

多分この影響かもです。
有効化されれば動いてます。

No.6 回答者： めぐみん_ 回答日時： 2020/05/01 12:22

No.5です。

別質問の回答を基に弄ったコードなので、Dictionaryが１個余計でしたね。
出勤したリスト・出勤しなかったリストの双方を作成しようとボケた考えでやりましたけど、出勤しなかったリストは別に作成しなくても出来ちゃいましたので。
もし無駄を省くと言う事なら考え直しますので仰ってください。

No.4 回答者： tom04 回答日時： 2020/05/01 10:51

こんにちは！

一例です。
尚、元データはSheet1にあり、Sheet2に表示するとして、
両シートともお示しの画像の配置通りとして・・・

そして、Sheet2の2行目の「氏名」は入力済みだという前提です。
Sheet2のセルの表示形式は好みの「日付」にしておいてください。

標準もシュールです。

Sub Sample1()
　Dim myDic As Object
　Dim i As Long, j As Long
　Dim lastRow As Long, lastCol As Long
　Dim maxRow As Long
　Dim myStr As String, wS As Worksheet
　Dim myDate As Date
　Dim myR

　　Set myDic = CreateObject("Scripting.Dictionary")
　　Set wS = Worksheets("Sheet2")
　　　'//▼Sheet2の3行目以降のデータを一旦消去//
　　　lastCol = wS.Cells(2, Columns.Count).End(xlToLeft).Column
　　　　For j = 2 To lastCol
　　　　　maxRow = WorksheetFunction.Max(maxRow, wS.Cells(Rows.Count, j).End(xlUp).Row)
　　　　Next j
　　　　　If maxRow > 2 Then
　　　　　　Range(wS.Cells(3, "B"), wS.Cells(maxRow, lastCol)).ClearContents
　　　　　End If

　　　'//▼ココから操作//
　　　With Worksheets("Sheet1")
　　　　lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
　　　　　myR = Range(.Cells(2, "A"), .Cells(lastRow, "B"))
　　　　　　For i = 1 To UBound(myR, 1)
　　　　　　　myStr = myR(i, 1) * 1 & "_" & myR(i, 2)
　　　　　　　　If Not myDic.exists(myStr) Then '//←念のため//
　　　　　　　　　myDic.Add myStr, ""
　　　　　　　　End If
　　　　　　Next i
　　　End With
　　　　For j = 2 To lastCol
　　　　　For i = 1 To Day(Date)
　　　　　　myDate = DateSerial(Year(Date), Month(Date), i)
　　　　　　myStr = myDate * 1 & "_" & wS.Cells(2, j)
　　　　　　　If Not myDic.exists(myStr) Then
　　　　　　　　wS.Cells(Rows.Count, j).End(xlUp).Offset(1) = myDate
　　　　　　　End If
　　　　　Next i
　　　　Next j
　　　　　Set myDic = Nothing
　　　　　wS.Activate
　　　　　MsgBox "完了"
End Sub

※　今日が5月1日なので、1日だけの検索になってしまいますので、
細かい検証はできていません。

お望み通りの動きにならなかったらごめんなさい。m(_ _)m

No.3 回答者： 銀鱗 回答日時： 2020/05/01 10:45

田中さんが無視されているのが気になるけど、気づかなかったことにしよう。

・・・本題・・・

マクロである必要ないと思うのは自分だけでしょうか。

もしも、マクロ（VBA）の勉強が目的という事であれば、
自身で試行錯誤した物を載せると良いと思います。

アルゴリズムとしては、左のシートの上の行から順番に「名前」を調べて、その名前に対応する右のシートの列に日付を書き写す。
こんだけです。
このアルゴリズムをプログラムに直す段階の何が分からないのかを補足してください。

No.2 回答者： めぐみん_ 回答日時： 2020/05/01 09:15

日報ってのが左の表のレイアウトだけであるなら、氏名を横並びにして出勤した日に印（日付と交差するセル）をつければ、それだけでも把握しやすいのでは？

実際は左の表については右方向にも何か記載する項目があるって事なのでしょうかね。

この回答へのお礼

左の表には右方向に複数の項目が存在し、U列まであります。
氏名と出てきていない日付を出したいです。

お礼日時：2020/05/01 10:31

No.1 回答者： lv4u 回答日時： 2020/05/01 07:43

https://www.officepro.jp/excelvba/