【不動産】家賃の請求と入金を照合し、未入金・一部入金の滞納者リストを作る

想定する場面

賃貸管理会社では、毎月の家賃の請求に対して入金があったかを確認し、滞納している入居者に督促を行います。入金は月によって遅れたり、2か月分がまとめて振り込まれたり、一部だけ振り込まれたりするため、単純に「今月の請求と今月の入金」を比べるだけでは正しい滞納状況が分かりません。

このマクロは、契約番号ごとに入金の合計を求め、それを古い請求月から順に充当していきます。充当しきれなかった請求が滞納分で、その件数を滞納月数として一覧にします。

データの形（例）

シートと列の構成は説明用の架空のものです。どちらのシートも、照合したい期間（たとえば今年度分）のデータが入っているものとします。入金明細の契約番号は、振込名義などから事前に入力しておく前提です。

• 「請求」シート：A列 請求月（各月1日の日付）、B列 契約番号、C列 物件名、D列 部屋番号、E列 契約者名、F列 請求額
• 「入金」シート：A列 入金日、B列 契約番号、C列 入金額、D列 振込名義
• 「滞納一覧」シート：マクロが結果を出力する

コード

最初に請求シートを請求月の古い順に並べ替えます。こうしておくと、上から順に処理するだけで、どの契約についても古い請求から入金が充当されます。金額は Currency 型で扱い、入金の合計を契約番号ごとに Dictionary に入れて、請求を1行ずつ消し込んでいきます。

Sub RentArrears()
    Dim billWs As Worksheet, payWs As Worksheet, outWs As Worksheet
    Dim bill As Variant, pay As Variant, out() As Variant
    Dim payDic As Object, resDic As Object, k As Variant, rec As Variant
    Dim lastRow As Long, i As Long, n As Long, unmatched As Long
    Dim amt As Currency, applied As Currency, remain As Currency

    Set billWs = ThisWorkbook.Worksheets("請求")
    Set payWs = ThisWorkbook.Worksheets("入金")
    Set outWs = ThisWorkbook.Worksheets("滞納一覧")

    ' 請求を請求月の古い順に並べ替える
    lastRow = billWs.Cells(billWs.Rows.Count, "A").End(xlUp).Row
    If lastRow < 2 Then MsgBox "請求データがありません": Exit Sub
    billWs.Range("A1:F" & lastRow).Sort Key1:=billWs.Range("A2"), Order1:=xlAscending, _
        Key2:=billWs.Range("B2"), Order2:=xlAscending, Header:=xlYes
    bill = billWs.Range("A2:F" & lastRow).Value

    ' 契約番号ごとの入金合計
    Set payDic = CreateObject("Scripting.Dictionary")
    lastRow = payWs.Cells(payWs.Rows.Count, "A").End(xlUp).Row
    If lastRow >= 2 Then
        pay = payWs.Range("A2:C" & lastRow).Value
        For i = 1 To UBound(pay, 1)
            If IsNumeric(pay(i, 3)) And Trim(CStr(pay(i, 2))) <> "" Then
                k = Trim(CStr(pay(i, 2)))
                payDic(k) = payDic(k) + CCur(pay(i, 3))
            End If
        Next i
    End If

    ' 古い請求から入金を充当する
    Set resDic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(bill, 1)
        k = Trim(CStr(bill(i, 2)))
        If k <> "" And IsNumeric(bill(i, 6)) Then
            amt = CCur(bill(i, 6))
            remain = 0
            If payDic.Exists(k) Then remain = payDic(k)
            If remain >= amt Then applied = amt Else applied = remain
            If payDic.Exists(k) Then payDic(k) = remain - applied

            If resDic.Exists(k) Then
                rec = resDic(k)
            Else
                rec = Array(k, bill(i, 3), bill(i, 4), bill(i, 5), CCur(0), CCur(0), 0&, Empty)
            End If
            rec(4) = rec(4) + amt
            rec(5) = rec(5) + applied
            If applied < amt Then
                rec(6) = rec(6) + 1                           ' 滞納月数
                If IsEmpty(rec(7)) Then rec(7) = bill(i, 1)   ' 最も古い未払いの月
            End If
            resDic(k) = rec
        End If
    Next i

    ' 請求のない契約番号への入金（照合できない入金）を数える
    For Each k In payDic.Keys
        If Not resDic.Exists(k) Then unmatched = unmatched + 1
    Next k

    outWs.Cells.Clear
    outWs.Range("A1:I1").Value = Array("契約番号", "物件名", "部屋", "契約者名", "請求計", _
        "入金充当計", "未収額", "滞納月数", "最古の未払月")
    If resDic.Count = 0 Then MsgBox "照合できる請求がありません": Exit Sub
    ReDim out(1 To resDic.Count, 1 To 10)
    For Each k In resDic.Keys
        rec = resDic(k)
        If rec(6) > 0 Then
            n = n + 1
            out(n, 1) = rec(0): out(n, 2) = rec(1): out(n, 3) = rec(2): out(n, 4) = rec(3)
            out(n, 5) = rec(4): out(n, 6) = rec(5): out(n, 7) = rec(4) - rec(5)
            out(n, 8) = rec(6): out(n, 9) = rec(7)
            If rec(5) = 0 Then out(n, 10) = "未入金" Else out(n, 10) = "一部入金"
        End If
    Next k
    outWs.Range("J1").Value = "状態"
    If n > 0 Then
        outWs.Range("A2").Resize(n, 10).Value = out
        outWs.Range("A1").Resize(n + 1, 10).Sort Key1:=outWs.Range("H2"), Order1:=xlDescending, Header:=xlYes
        For i = 2 To n + 1
            If outWs.Cells(i, 8).Value >= 3 Then
                outWs.Range("A" & i & ":J" & i).Interior.Color = RGB(255, 180, 180)
            ElseIf outWs.Cells(i, 8).Value = 2 Then
                outWs.Range("A" & i & ":J" & i).Interior.Color = RGB(255, 230, 170)
            End If
        Next i
        outWs.Range("E:G").NumberFormatLocal = "#,##0"
        outWs.Range("I:I").NumberFormatLocal = "yyyy/mm"
    End If
    MsgBox "滞納 " & n & " 件" & vbCrLf & "照合できない入金の契約番号：" & unmatched & " 件"
End Sub

コードのポイント

入金を「どの月の家賃か」で区別せず、契約番号ごとの合計として扱い、古い請求から順に充当しています。2か月分まとめての入金や、遅れて入金された前月分も自然に消し込まれるため、入金の摘要を1件ずつ読んで月を判断する必要がありません。

滞納月数は「全額充当できなかった請求の数」です。一部だけ入金された月も1か月として数えるので、督促の優先度を判断する目安になります。結果は滞納月数の多い順に並べ、3か月以上を赤、2か月を黄色で色付けしています。

金額は Currency 型で計算しているため、Double 型で足し引きしたときのような端数の誤差で「未収額 0.0000001 円」といった行が出ることはありません。

運用上の注意

請求のない契約番号に入金がある場合（契約番号の入力ミスや、解約済みの契約への入金など）は、件数だけを表示しています。担当者が個別に確認できるよう、必要に応じてその入金を別シートに書き出す処理を加えてください。また、充当したあとも入金が余っている契約は、前受金や過入金の可能性があります。

• 請求シートを並べ替えるため、実行前にブックを保存しておく
• 照合期間は請求と入金でそろえる（期間外の入金が混ざると滞納が少なく出る）
• 敷金・更新料・共益費などを家賃と分けて管理している場合は、請求の種類ごとに照合する
• 滞納者リストは個人情報を含むため、社内ルールに沿って取り扱う

ほかの記事