学校の家庭数カウント関数

Question

前提・実現したいこと

・学校の家庭数を正確にカウントしたい。
・コードにミスがないか教えていただきたい。
・よりスマートなコードがあれば教えていただきたい。

※家庭数＝上の学年や同学年に兄弟姉妹のいない児童数

・児童名簿シート

41は学年が４、クラスが1の意で、そのクラスに兄弟姉妹がいることを示す。
兄弟姉妹は最大3人まで。

・実現したいシートの例

該当のソースコード

Option Explicit

Public Function CountFamily(ByVal Grade As Long, ByVal Class As Long) As Long
    
    Dim i As Long
    Dim lngDataCnt As Long
    Dim lngFamilyCnt As Long
    
    With Worksheets("児童名簿")
        lngDataCnt = .Range("A1").End(xlDown).Row
        
        For i = 2 To lngDataCnt
            If .Cells(i, 1) = Grade And .Cells(i, 2) = Class Then
               If .Cells(i, 7) < (Grade * 10 + Class) And _
                  .Cells(i, 8) < (Grade * 10 + Class) And _
                  .Cells(i, 9) < (Grade * 10 + Class) Then
                    lngFamilyCnt = lngFamilyCnt + 1
                End If
            End If
        Next i
    
    End With
    
    CountFamily = lngFamilyCnt
    
End Function

試したこと

数学級分手作業で家庭数を数えて確認した。

補足情報（FW/ツールのバージョンなど）

Excel 2016

Answer 1

正確にカウントできていると思います。
以下のようなチェックで安心できるのではないでしょうか。
・マクロは、生徒の並び順を変えても結果が同じになる

＜解決後追記＞
論理的に正しいコードでも、数字で入力されていない場合、誤った結果となります。
G~I列が数字で入力されていることのチェックを追加してみました。

Public Function CountFamily(ByVal Grade As Long, ByVal Class As Long) As Long

    Dim i As Long
    Dim lngDataCnt As Long
    Dim lngFamilyCnt As Long

    With Worksheets("児童名簿")
        lngDataCnt = .Range("A1").End(xlDown).Row

        For i = 2 To lngDataCnt
            If .Cells(i, 1).Value = Grade And .Cells(i, 2).Value = Class Then
                '数字で入力されていることをチェック
                If IsNumeric(.Cells(i, 7).Value) And _
                   IsNumeric(.Cells(i, 8).Value) And _
                   IsNumeric(.Cells(i, 9).Value) Then
                
                    If .Cells(i, 7).Value < (Grade * 10 + Class) And _
                       .Cells(i, 8).Value < (Grade * 10 + Class) And _
                       .Cells(i, 9).Value < (Grade * 10 + Class) Then
                        lngFamilyCnt = lngFamilyCnt + 1
                    End If
                Else
                    MsgBox "数字で入力されていない箇所があります。"
                    CountFamily = -1
                    Exit Function
                End If
            End If
        Next i
    End With

    CountFamily = lngFamilyCnt

End Function

Comments

[wakame01]

ありがとうございます。
並び順をランダムに変えても結果は同じになりました。

[wakame01]

コードに追加させていただきます。
ありがとうございます。