はじめに

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

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

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