就業時間外に送信されたメールを抽出する
タイトルのマクロは、以下です。
Sub CheckEmailsOutsideWorkHours()
Dim ws As Worksheet
Dim lastRow As Long, lastRowI As Long
Dim i As Long, j As Long
Dim sendTime As Date, startTime As Date, endTime As Date
Dim employeeCode As String
Dim inWorkingHours As Boolean
Set ws = ThisWorkbook.Sheets("Sheet1")
' 送信メール履歴の最終行を取得
lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
' 出勤状況リストの最終行を取得
lastRowI = ws.Cells(ws.Rows.Count, "I").End(xlUp).Row
For i = 2 To lastRow
' B列の社員コードを取得
employeeCode = ws.Cells(i, "B").Value
' D列の送信時間を取得
sendTime = ws.Cells(i, "D").Value
' 就業時間内かどうかのフラグを初期化
inWorkingHours = False
' 社員コードが一致する行をI列から探す
For j = 2 To lastRowI
If ws.Cells(j, "I").Value = employeeCode Then
' P列の始業時間とQ列の終業時間を取得
startTime = ws.Cells(j, "P").Value
endTime = ws.Cells(j, "Q").Value
' 送信時間が始業時間と終業時間の間にあるかをチェック
If sendTime >= startTime And sendTime <= endTime Then
inWorkingHours = True
Exit For
End If
End If
Next j
' 就業時間内かどうかでA列に結果を設定
If inWorkingHours Then
ws.Cells(i, "A").Value = ""
Else
ws.Cells(i, "A").Value = "×"
End If
Next i
End Sub【前提】
①終業時間外とは始業時間前・始業時間後を指します。
②D列に送信したメールの時間が「年月日時分」で入っています。
③P列には始業時間が「年月日時分」で入っています。
④検索はB列の社員ｺｰﾄﾞとI列の社員ｺｰﾄﾞが一致している行すべてを検索行とします。
⑤今回は見やすいようにAさんだけを載せています。Aさんの最終行以降にBさん・Cさんと情報が積みあがります。
⑥B列からG列が送信メール履歴のリストです。
⑦I列からQ列は出勤状況のリストです。
⑧「⑥と⑦」は同じシートに入っています。
⑨時間はシリアル値でみることになります(多分)
⑩始業時間が遅いん場合、終業時間は日をまたぐ(翌日になる)場合があります。
【やりたい事】
①B2の社員ｺｰﾄﾞと同じものをI列から全て探します。
②「①」で見つかった範囲の中からさらに検索します。 D2の時間「年月日時分」を検索値として、P列（始業時間)とQ列(終業時間)の間にに入っているか探します。
※Ｐ列とQ列は同じ行で見ます。 ③D2の値が「D2<P(i)<Q(i)<D2」のようにPとQの間に入っているもの見つからなければ」A2に「×」を入れます。 D2の値が「P(i)<D2<Q(i)」のようにPとQの間に入っているものがみつかれば」A2は空欄のままにします。
これを送信メールの範囲で最終行まで繰り返します。
Sub CheckEmailsOutsideWorkHours()
目的
このマクロは、送信されたメールの時間が就業時間外（始業時間前または終業時間後）に送信されたかどうかをチェックし、その結果をワークシートの A 列に記録します。
詳細説明
Dim ws As Worksheet
Dim lastRow As Long, lastRowI As Long
Dim i As Long, j As Long
Dim sendTime As Date, startTime As Date, endTime As Date
Dim employeeCode As String
Dim inWorkingHours As Boolean- 変数宣言
ws: 作業対象となるワークシートを格納する変数lastRow,lastRowI: それぞれ送信メール履歴と出勤状況リストの最終行を格納する変数i,j: ループカウンタsendTime: 送信時間を格納する変数startTime,endTime: 始業時間と終業時間を格納する変数employeeCode: 社員コードを格納する変数inWorkingHours: 就業時間内かどうかを示すフラグ
Set ws = ThisWorkbook.Sheets("Sheet1")- ワークシートの設定
ws変数に対象のワークシートを設定します。
' 送信メール履歴の最終行を取得
lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
' 出勤状況リストの最終行を取得
lastRowI = ws.Cells(ws.Rows.Count, "I").End(xlUp).Row- 最終行の取得
lastRow: 送信メール履歴の最終行を取得します。lastRowI: 出勤状況リストの最終行を取得します。
For i = 2 To lastRow
' B列の社員コードを取得
employeeCode = ws.Cells(i, "B").Value
' D列の送信時間を取得
sendTime = ws.Cells(i, "D").Value
' 就業時間内かどうかのフラグを初期化
inWorkingHours = False- 送信メール履歴のループvbaCopy code
- 各送信メール履歴の行をループし、
B列の社員コードとD列の送信時間を取得します。 inWorkingHoursフラグをFalseに初期化します。
- 各送信メール履歴の行をループし、
' 社員コードが一致する行をI列から探す
For j = 2 To lastRowI
If ws.Cells(j, "I").Value = employeeCode Then
' P列の始業時間とQ列の終業時間を取得
startTime = ws.Cells(j, "P").Value
endTime = ws.Cells(j, "Q").Value
' 送信時間が始業時間と終業時間の間にあるかをチェック
If sendTime >= startTime And sendTime <= endTime Then
inWorkingHours = True
Exit For
End If
End If
Next j- 出勤状況リストのループ
- 社員コードが一致する出勤状況リストの行を探します。
- 該当行の
P列（始業時間）とQ列（終業時間）を取得します。 - 送信時間が始業時間と終業時間の間にあるかをチェックし、条件に一致する場合
inWorkingHoursフラグをTrueに設定して内側のループを終了します。
' 就業時間内かどうかでA列に結果を設定
If inWorkingHours Then
ws.Cells(i, "A").Value = ""
Else
ws.Cells(i, "A").Value = "×"
End If- 結果の設定
- 送信時間が始業時間と終業時間の間にあれば
A列に空白を設定します。 - そうでなければ
A列に×を設定します。
- 送信時間が始業時間と終業時間の間にあれば
Next i- ループの終了
- すべての送信メール履歴を処理するまでループを繰り返します。
このマクロは、送信メール履歴と出勤状況リストを比較して、メールの送信時間が就業時間外であれば A 列に × を設定し、就業時間内であれば空白を設定します。
実行結果
マクロを実行すると、以下のように、A列に判定が表示されます。
Follow me!
