【Excel/VBA】国保連の介護給付費請求データ作成・CSV出力・逆復元を完全自動化する

はじめに

介護事業所の請求業務において、国保連（国民健康保険団体連合会）への伝送データ作成はミスが許されない重要な業務です。

「使い慣れたExcelで明細を入力・管理しつつ、国保連指定のフォーマットでCSV出力したい」
「万が一、元データを失った際に伝送データからExcelを復元したい」

本記事では、Excel（VBA）と国保中央会の「介護電子媒体化ソフト」を連携させる効率的なワークフロー、全体の処理フロー図、およびコピペでそのまま使える完全ソースコードをまとめて紹介します。

---

1. 全体アーキテクチャと処理の流れ

Excelと介護電子媒体化ソフトは、以下のように役割を明確に分けることで、複雑な給付計算やフォーマットエラーを防ぐことができます。

• Excel（VBA）側: 利用者ごとの基本情報やサービス明細（どのコードを何回使ったか）の「素材」を用意してCSV出力する。（※合計単位数や請求額の複雑な計算は不要です）
• 介護電子媒体化ソフト側: インポートした明細をもとに、単位数の集計・給付額・自己負担額の計算、エラーチェック、および様式（請求書・明細書）の印刷・伝送データ生成を行います。

全体処理フロー（PlantUML）

---

2. 介護伝送CSVのレイアウト仕様と重要ルール

介護電子媒体化ソフトが受け付けるCSVは、国保連の仕様に準拠したヘッダー・ディテール構造になっています。

• 主要レコード構成
  • 7111（基本情報レコード）: 事業所番号、被保険者番号、請求年月、要介護状態区分など
  • 7112（サービス明細レコード）: サービスコード、単位数、回数、日別実施状況など
• ハマりやすい重要ポイント
  1. 文字コード: 必ず Shift-JIS (CP932) で保存する（UTF-8では読み込みエラー・文字化けになります）。
  2. 前置ゼロ（0埋め）: 事業所番号（10桁）や被保険者番号（10桁）は、Excel側で数値扱いになると先頭の 0 が消えるため、出力時に強制0埋め処理を入れる。
  3. サービス種別による違い: 大枠の構造は共通ですが、サービス（訪問・通所・居宅・施設など）によって専用レコードが追加されるため、まずはソフト側でダミーデータを1件作ってCSVエクスポートし、レイアウトを確認するのが確実です。

---

3. シート構造と前準備

VBAを実行する前に、ワークブック内に以下の標準モジュールとワークシートを作成・命名してください。

• 標準モジュール名: M_KokuhoAutomation
• シート構成:
  1. 明細データ （CSV出力用の入力シート）
  2. 基本情報 （伝送データ復元先のシート）
  3. 明細 （伝送データ復元先のシート）

明細データ シートの列レイアウト（1行目ヘッダー）

A列	B列	C列	D列	E列	F列	G列
交換識別コード	事業所番号	被保険者番号	提供年月	サービスコード	単位数	回数

---

4. 完全VBAソースコード

以下のコードをVBAエディタ（Alt + F11）で作成した標準モジュール（M_KokuhoAutomation）に貼り付けて使用します。

Option Explicit

' ==============================================================================
' 介護給付費請求データ自動化モジュール
' ==============================================================================

' ------------------------------------------------------------------------------
' 1. Excelデータから介護用CSVを出力するメイン処理
' ------------------------------------------------------------------------------
Public Sub ExportKokuhoCsv()
    On Error GoTo ErrorHandler

    Dim ws As Worksheet
    On Error Resume Next
    Set ws = ThisWorkbook.Sheets("明細データ")
    On Error GoTo ErrorHandler
    
    If ws Is Nothing Then
        MsgBox "シート『明細データ』が見つかりません。シート名を確認してください。", vbCritical, "エラー"
        Exit Sub
    End If

    ' 保存パスの設定（実行ファイルと同じフォルダにタイムスタンプ付きで出力）
    Dim filePath As String
    filePath = ThisWorkbook.Path & "\介護給付費明細取込データ_" & Format(Now, "YYYYMMDD_HHNNSS") & ".csv"

    ' ADODB.StreamオブジェクトでShift-JIS指定出力
    Dim stream As Object
    Set stream = CreateObject("ADODB.Stream")
    
    With stream
        .Type = 2 ' adTypeText
        .Charset = "Shift-JIS"
        .Open
    End With

    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    If lastRow < 2 Then
        MsgBox "出力対象のデータが存在しません。（2行目以降にデータを入力してください）", vbExclamation, "警告"
        Exit Sub
    End If

    Dim r As Long
    Dim lineStr As String
    Dim exportCount As Long: exportCount = 0

    For r = 2 To lastRow
        ' データが存在する行のみ処理
        If Trim(ws.Cells(r, 1).Value) <> "" Then
            ' 項目取得とデータ整形（ゼロ埋め・桁数揃え）
            Dim exchangeCode As String: exchangeCode = Trim(ws.Cells(r, 1).Value)
            Dim jigyoshoNo As String:   jigyoshoNo   = FormatZeroPadding(Trim(ws.Cells(r, 2).Value), 10) ' 事業所番号(10桁)
            Dim hihokenshaNo As String: hihokenshaNo = FormatZeroPadding(Trim(ws.Cells(r, 3).Value), 10) ' 被保険者番号(10桁)
            Dim serviceYm As String:    serviceYm    = Trim(ws.Cells(r, 4).Value)                        ' 提供年月(YYYYMM)
            Dim serviceCode As String:  serviceCode  = Trim(ws.Cells(r, 5).Value)                        ' サービスコード(6桁)
            Dim unitPrice As String:    unitPrice    = CStr(Val(ws.Cells(r, 6).Value))                   ' 単位数
            Dim countTimes As String:   countTimes   = CStr(Val(ws.Cells(r, 7).Value))                   ' 回数

            ' カンマ区切り行の組み立て
            lineStr = exchangeCode & "," & _
                      jigyoshoNo & "," & _
                      hihokenshaNo & "," & _
                      serviceYm & "," & _
                      serviceCode & "," & _
                      unitPrice & "," & _
                      countTimes

            ' 1行出力 (改行コード: CRLF)
            stream.WriteText lineStr, 1
            exportCount = exportCount + 1
        End If
    Next r

    ' ファイルへの書き出し
    stream.SaveToFile filePath, 2 ' 2: adSaveCreateOverWrite
    stream.Close
    Set stream = Nothing

    MsgBox "CSV出力が正常に完了しました。" & vbCrLf & _
           "件数: " & exportCount & " 件" & vbCrLf & _
           "保存先: " & filePath, vbInformation, "完了"
    Exit Sub

ErrorHandler:
    MsgBox "エラーが発生しました: " & Err.Description, vbCritical, "システムエラー"
    If Not stream Is Nothing Then
        On Error Resume Next
        stream.Close
        Set stream = Nothing
    End If
End Sub

' ------------------------------------------------------------------------------
' 2. 国保連伝送ファイル（CSV/TXT）からExcelシートへ逆復元する処理
' ------------------------------------------------------------------------------
Public Sub RestoreDataFromKokuhoFile()
    On Error GoTo ErrorHandler

    ' ファイル選択ダイアログを表示
    Dim filePath As Variant
    filePath = Application.GetOpenFilename( _
        FileFilter:="国保連データファイル (*.csv; *.txt), *.csv; *.txt", _
        Title:="復元する国保連データファイルを選択してください" _
    )

    If filePath = False Then Exit Sub ' キャンセル時

    ' Shift-JISでファイルを読み込み
    Dim stream As Object
    Set stream = CreateObject("ADODB.Stream")
    
    With stream
        .Type = 2 ' adTypeText
        .Charset = "Shift-JIS"
        .Open
        .LoadFromFile CStr(filePath)
    End With

    Dim textData As String
    textData = stream.ReadText(-1) ' 全文読み込み
    stream.Close
    Set stream = Nothing

    ' 改行コードで分割
    Dim lines() As String
    textData = Replace(textData, vbCr, "") ' CR除去
    lines = Split(textData, vbLf)          ' LFで分割

    If UBound(lines) < 0 Then
        MsgBox "ファイル内にデータが存在しません。", vbExclamation, "エラー"
        Exit Sub
    End If

    ' 書き込み先シートの準備
    Dim wsBase As Worksheet, wsDetail As Worksheet
    On Error Resume Next
    Set wsBase = ThisWorkbook.Sheets("基本情報")
    Set wsDetail = ThisWorkbook.Sheets("明細")
    On Error GoTo ErrorHandler

    If wsBase Is Nothing Or wsDetail Is Nothing Then
        MsgBox "『基本情報』または『明細』シートが存在しません。", vbCritical, "エラー"
        Exit Sub
    End If

    ' 画面更新停止で高速化
    Application.ScreenUpdating = False

    ' 既存データの全クリア
    wsBase.Cells.Clear
    wsDetail.Cells.Clear

    ' ヘッダーの設定
    wsBase.Range("A1:D1").Value = Array("レコード識別", "事業所番号", "被保険者番号", "提供年月")
    wsDetail.Range("A1:D1").Value = Array("レコード識別", "サービスコード", "単位数", "回数")

    Dim rowBase As Long: rowBase = 2
    Dim rowDetail As Long: rowDetail = 2
    Dim i As Long, j As Long
    Dim recordType As String
    Dim fields() As String

    ' 各行のパースと振り分け
    For i = LBound(lines) To UBound(lines)
        If Trim(lines(i)) <> "" Then
            fields = Split(lines(i), ",")
            
            If UBound(fields) >= 0 Then
                ' 先頭項目からレコード種別を検出
                recordType = Left(Trim(fields(0)), 4)

                Select Case recordType
                    Case "7111" ' 基本情報レコード
                        For j = LBound(fields) To UBound(fields)
                            wsBase.Cells(rowBase, j + 1).Value = Trim(fields(j))
                        Next j
                        rowBase = rowBase + 1

                    Case "7112" ' サービス明細レコード
                        For j = LBound(fields) To UBound(fields)
                            wsDetail.Cells(rowDetail, j + 1).Value = Trim(fields(j))
                        Next j
                        rowDetail = rowDetail + 1

                    Case Else
                        ' その他のレコード（必要に応じて拡張可能）
                End Select
            End If
        End If
    Next i

    Application.ScreenUpdating = True

    MsgBox "復元処理が完了しました！" & vbCrLf & _
           "基本情報: " & (rowBase - 2) & " 件" & vbCrLf & _
           "明細情報: " & (rowDetail - 2) & " 件", vbInformation, "完了"
    Exit Sub

ErrorHandler:
    Application.ScreenUpdating = True
    MsgBox "エラーが発生しました: " & Err.Description, vbCritical, "システムエラー"
    If Not stream Is Nothing Then
        On Error Resume Next
        stream.Close
        Set stream = Nothing
    End If
End Sub

' ------------------------------------------------------------------------------
' 共通補助関数: 先頭ゼロ埋め整形処理
' ------------------------------------------------------------------------------
Private Function FormatZeroPadding(ByVal inputVal As String, ByVal totalLength As Integer) As String
    Dim cleanVal As String
    cleanVal = Trim(inputVal)
    
    If cleanVal = "" Then
        FormatZeroPadding = String(totalLength, "0")
    ElseIf Len(cleanVal) >= totalLength Then
        FormatZeroPadding = Right(cleanVal, totalLength)
    Else
        FormatZeroPadding = String(totalLength - Len(cleanVal), "0") & cleanVal
    End If
End Function

---

5. 関連リンク・公式情報リファレンス

国保連へのデータ伝送や「介護電子媒体化ソフト」、公式の仕様詳細については、以下の公式ページをご参照ください。

• 国保中央会（国民健康保険中央会）公式サイト
  • 全国共通の介護保険制度関連情報や、電子請求・伝送に関する総合的な案内を確認できます。
• 介護電子媒体化ソフトのダウンロード
  • 各都道府県の「国民健康保険団体連合会（国保連）」の公式サイト内、または国保中央会のポータルから無償でダウンロード可能です（※必ず請求月・審査月に対応した最新版をご利用ください）。
• 厚生労働省：介護保険の請求に関する基準・仕様情報
  • 介護給付費請求書等の電子情報処理組織による請求に関わるインターフェース仕様書が掲載されています。

---

おわりに

Excel・VBAで明細データの作成・出力（および万が一の逆復元）を自動化し、複雑な給付計算やエラーチェックは「介護電子媒体化ソフト」に任せる分業体制をとることで、手作業による入力ミスやフォーマット不一致による返戻リスクを大幅に削減できます。

ぜひ日々の請求業務効率化にお役立てください。