excelで入力忘れを抽出したい

Question

社員の体温管理をグーグルスプレットでアンケート方式で収集しています。
報告は、起床時と就寝前。
出社後、特定の社員が前日の夜、本日の朝の体温が入力されているか目視でチェックしています。

No 氏名 測温時 体温 日にち
1 豊田 夜 36.5℃ 7月1日
1 豊田 朝 36.4℃ 7月2日
2 高橋 夜 36.1℃ 7月1日
2 高橋 朝 37.5℃ 7月2日
3 加藤 夜 36.2℃ 7月1日
4 佐々木 夜 36.7℃ 7月1日
4 佐々木 朝 36.2℃ 7月2日
5 田中 夜 32.5℃ 7月1日
5 田中 朝 36.9℃ 7月2日
6 矢野 朝 35.9℃ 7月1日
7 菅野 夜 36.9℃ 7月1日
7 菅野 朝 37.3℃ 7月2日

上記だとNo3加藤の朝、No6矢野の夜が抜けていますね。
この抜けている部分を一覧で抽出したいです。
3 加藤 朝
6 矢野 夜
このように。

vbaで行いたいです。

管理上、毎日exceへコピーし保存しています。
考え方だけでも結構です。回答より敷くお願いします。

Answer 1

1. 鈴木さんのように夜と朝の両方を記入忘れした場合も考慮してみました。
2. 発熱時の表示を簡易的に入れてみました（38度以上には対応していません。）

Sub KenOnCheck()
    Dim ws As Worksheet
    Set ws = ActiveSheet
    Dim member, timing, message
    For Each member In Split("豊田 高橋 加藤 佐々木 田中 矢野 菅野 鈴木")
    For Each timing In Split("夜 朝")
        If WorksheetFunction.CountIfs(ws.Range("B:B"), member, ws.Range("C:C"), timing) < 1 Then
            message = Join(Array(message, member, timing, vbLf))
        ElseIf WorksheetFunction.CountIfs(ws.Range("B:B"), member, ws.Range("C:C"), timing, ws.Range("D:D"), "37*") > 0 Then
            message = Join(Array(message, member, timing, "Hot", vbLf))
        End If
    Next
    Next
    MsgBox message
End Sub

Answer 2

Noと氏名をキーとした一般的な、ブレーク処理です。
1行目をタイトルとして、A2より値をセットしたと仮定。下記の様なコードになると思われます。
コピペして動かして見て下さい。

Sub Test_Sample_Miniature()
    
    Dim MyRange As Range
    Dim blnBrkInit As Boolean
    Dim strBrkKey As String
    Dim strBrkWork As String
    Dim blnSkip As Boolean
    Dim lngCheckCount As Long
    
    blnBrkInit = True
    For Each MyRange In Range("A:A")
        '
        '(初期)
        blnSkip = False
        If MyRange.Row = 1 Then blnSkip = True
        '
        '(行値有効)
        If blnSkip = False Then
            '(ブレーク開始)
            strBrkWork = Trim(Cells(MyRange.Row, 1)) & Trim(Cells(MyRange.Row, 2))
            If blnBrkInit = True Then
                '(初期処理)
                strBrkKey = strBrkWork
                lngCheckCount = 1
                blnBrkInit = False
            Else
                If strBrkKey <> strBrkWork Then
                    '(不一致)
                    If lngCheckCount <> 2 Then
                        Cells(MyRange.Row - 1, 6) = "データ不正=" & lngCheckCount
                    End If
                    strBrkKey = strBrkWork
                    lngCheckCount = 1
                Else
                    '(一致)
                    lngCheckCount = lngCheckCount + 1
                End If
            End If
            '
        End If
        '
        '(空白終了)
        If Trim(MyRange) = "" Then exit for
        '
    Next

End Sub

Comments

[xoxo_999]

ありがとうございます。
試してみます。

Answer 3

直接の回答ではありません。
日付は前日と当日だけの前提で良いでしょうか。以下、その前提でのコメントです。
1案
もっとも簡単な手抜きの方法ですが、
各担当者の出現回数をカウントし、１件のデータのみ抽出する方法です。
この場合、３件以上あったらどうするかということも考慮したほうがよいかも知れませんが、
そんなことはあり得ない、とあなたが判断されれば、考慮する必要はないでしょう。

２案
もうすこし、厳密に判断する必要があるなら、
１案で２件以外はエラーとしたとき、２件であっても更にチェックを行います。
例えば
豊田 夜 36.5℃ 7月1日
豊田 夜 36.5℃ 7月2日
のようなケース（夜が2回）
豊田 夜 36.5℃ 7月1日
豊田 朝 36.5℃ 7月1日
のようなケース（同じ日付が２回）を正常とするのかエラーとするのかは、あなたが判断すべきことです。

又
豊田 夜 36.5℃ 7月1日
豊田 朝 36.5℃ 7月1日
菅野 夜 36.9℃ 7月3日
菅野 朝 37.3℃ 7月4日
のようなデータがあった場合、どちらを正常にするのか、もしくはどちらも正常にするのかは
あなたが判断すべきことです。

まずは、どの案でやるのか。
その場合の正常ケースとエラーケースをどのようにするかを明確にする必要があるかと。

Comments

[xoxo_999]

返信遅くなり申し訳ありません。
ありがとうございます。
よくよく考えてみます。