【保険】契約一覧から更新月が近い顧客を抽出して案内リストを作る

想定する場面

保険代理店や保険会社の営業部門では、満期（更新）を迎える契約者に対して、2〜3か月前から更新の案内を行います。契約一覧から対象者を探して担当者ごとに振り分ける作業を毎月手作業で行うと、抽出漏れによる案内忘れが起きかねません。

このマクロは、指定した年月に満期を迎える契約を抽出し、担当者ごとにシートを分けて案内リストを作ります。

データの形（例）

「契約一覧」シートを次の列構成とします。

• A列：証券番号
• B列：契約者名
• C列：商品種別
• D列：満期日
• E列：保険料（年額）
• F列：担当者
• G列：電話番号

コード

案内の対象とする年月（例：3か月後）を計算し、満期日がその月の契約を担当者ごとに Dictionary で振り分けます。担当者ごとに「案内_担当者名」というシートを作り直して出力します。

Sub RenewalList()
    Dim ws As Worksheet, data As Variant, dic As Object, k As Variant
    Dim target As Date, i As Long, outWs As Worksheet, recRows As Collection, r As Long, j As Long
    Dim summary As String

    target = DateSerial(Year(Date), Month(Date) + 3, 1)        ' 3か月後の月
    Set ws = ThisWorkbook.Worksheets("契約一覧")
    data = ws.Range("A2:G" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row).Value
    Set dic = CreateObject("Scripting.Dictionary")

    For i = 1 To UBound(data, 1)
        If IsDate(data(i, 4)) Then
            If Year(data(i, 4)) = Year(target) And Month(data(i, 4)) = Month(target) Then
                If Not dic.Exists(data(i, 6)) Then dic.Add data(i, 6), New Collection
                dic(data(i, 6)).Add i                          ' 行番号を担当者ごとに記録
            End If
        End If
    Next i

    Application.DisplayAlerts = False
    For Each k In dic.Keys
        On Error Resume Next
        ThisWorkbook.Worksheets("案内_" & k).Delete
        On Error GoTo 0
        Set outWs = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
        outWs.Name = Left("案内_" & k, 31)
        outWs.Range("A1:H1").Value = Array("証券番号", "契約者名", "商品種別", "満期日", "保険料", "担当者", "電話番号", "案内状況")
        Set recRows = dic(k)
        For r = 1 To recRows.Count
            For j = 1 To 7
                outWs.Cells(r + 1, j).Value = data(recRows(r), j)
            Next j
        Next r
        outWs.Columns("A:H").AutoFit
        summary = summary & k & "：" & recRows.Count & " 件" & vbCrLf
    Next k
    Application.DisplayAlerts = True
    MsgBox Format(target, "yyyy年m月") & " 満期の案内リストを作成しました" & vbCrLf & summary
End Sub

コードのポイント

Dictionary の値に Collection（行番号の入れ物）を持たせることで、担当者ごとに該当する行をまとめています。担当者が何人いても、コードを変えずに対応できます。

シート名には31文字の上限と使えない記号があるため、担当者名をそのまま使う場合は注意が必要です。担当者コードをシート名に使うと安全です。また、シートの削除と作成を繰り返すので、実行前にブックを保存しておくことをおすすめします。

運用の工夫と注意

出力した案内リストの「案内状況」列に、電話した日や案内状の送付日を記録していくと、そのまま進捗管理表として使えます。前月の案内リストを残しておきたい場合は、シート名に年月を付けるように変更してください。

契約一覧には個人情報が含まれます。担当者別のリストを別ファイルにして配布する場合は、ファイルの保存場所やパスワードの設定など、社内の情報管理ルールに従って扱ってください。

ほかの記事