Sub CheckAndGenerateMail()
Dim wsDep As Worksheet, wsTask As Worksheet, wsAll As Worksheet
Dim lastRowDep As Long, lastRowTask As Long, lastRowAll As Long
Dim i As Long
Dim ngCounter As Long
ngCounter = 0
' シートを設定
Set wsDep = ThisWorkbook.Worksheets("依頼全件")
Set wsTask = ThisWorkbook.Worksheets("打鍵リスト")
Set wsAll = ThisWorkbook.Worksheets("計数")
' 最終行を取得
lastRowDep = wsDep.Cells(wsDep.Rows.Count, "B").End(xlUp).Row
lastRowTask = wsTask.Cells(wsTask.Rows.Count, "C").End(xlUp).Row
' 依頼全件シートをループして処理
For i = 2 To lastRowDep
' A列i行のセル値が「1件目」かどうかを確認
If wsDep.Cells(i, "A").Value = "1件目" Then
' 依頼全件B列i行目のセル値が打鍵リストC列に存在するかを確認
Dim foundRange As Range
Set foundRange = wsTask.Range("C:C").Find(wsDep.Cells(i, "B").Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not foundRange Is Nothing Then ' 打鍵リストに存在する場合
' 検索出来た打鍵リストA列のセル値が「OK」かどうかを確認
Dim foundRow As Long
foundRow = foundRange.Row
If wsTask.Cells(foundRow, "A").Value <> "OK" Then
ngCounter = ngCounter + 1
End If
End If
End If
Next i
' 結果集計のサブルーチンを呼び出す（コードはここに記述）
Call 結果集計(ngCounter)
End Sub
Sub 結果集計(ngCounter As Long)
'┏━━━━━━━━━━━━┓
'┃ メールを生成 ┃
'┗━━━━━━━━━━━━┛
' 本文2を生成
Dim resultText As String
resultText = "■計数表と打鍵対象の件数はすべて一致したか？" & vbCrLf
If ngCounter = 0 Then
resultText = resultText & "全件OK、エラーなし" & vbCrLf
Else
resultText = resultText & "NGが" & ngCounter & "件発生しました。マニュアル確認が必要です。" & vbCrLf
End If
resultText = resultText & vbCrLf & "■本メールの送信元（マクロ）" & vbCrLf
resultText = resultText & ThisWorkbook.Path
' メール生成に必要な情報を取得
Dim toAddress As String, ccAddress As String, subject As String, body1 As String, body2 As String, body3 As String
toAddress = Main.Range("メールTo").Value
ccAddress = Main.Range("メールCc").Value
subject = Main.Range("メール件名").Value
body1 = Main.Range("メール本文1").Value
body2 = resultText ' 集約した結果を挿入
body3 = Main.Range("メール本文3").Value
' メール送信
Dim outlookApp As Object
Set outlookApp = CreateObject("Outlook.Application")
Dim mail As Object
Set mail = outlookApp.CreateItem(0)
mail.To = toAddress
mail.cc = ccAddress
mail.subject = subject
mail.body = body1 & vbCrLf & vbCrLf & body2 & vbCrLf & vbCrLf & body3
mail.Display ' メールを表示（送信しない）
'mail.Send ' メールを送信する場合は、Displayの代わりにSendを使用する
' 後処理
Set mail = Nothing
Set outlookApp = Nothing
End Sub