継続文字連結

’定数定義
’継続文字による無限継続を防ぐための上限値
’通常のVBAコードで100行を超える継続は異常であり、
’メモリ使用量やパフォーマンスを考慮した安全な閾値として設定
Private Const C_MAX_CONTINUATION_LINES As Integer = 100

’–––––––––––––––––––––––––
’プロシージャの概要:
’処理名:継続文字解決処理メイン
’概要:事前フィルタリング済みテーブルから継続文字を解決し、1行に結合する
’–––––––––––––––––––––––––
Sub exec継続文字解決処理()
Dim strSQL As String

```
'出力テーブルの既存データ削除
strSQL = "DELETE FROM t03_継続文字解決後"
CurrentDb.Execute strSQL

'継続文字解決処理実行
Call process継続文字解決

'処理完了メッセージ
MsgBox "継続文字解決処理が完了しました。"
```

End Sub

’–––––––––––––––––––––––––
’プロシージャの概要:
’処理名:継続文字解決メイン処理
’概要:事前フィルタリング済みデータから継続文字を解決して結合
’–––––––––––––––––––––––––
Sub process継続文字解決()
Dim rsSource As DAO.Recordset
Dim strSQL As String
Dim lngBaseID As Long
Dim strResolvedCode As String
Dim strElementIDList As String
Dim binContinuationMode As Boolean
Dim intContinuationCount As Integer

```
'元データを順次処理するため昇順ソート
strSQL = "SELECT * FROM t02_事前フィルタリング後 "
strSQL = strSQL & "ORDER BY コードラインID"

Set rsSource = CurrentDb.OpenRecordset(strSQL)

If rsSource.EOF Then
    rsSource.Close
    Set rsSource = Nothing
    Exit Sub
End If

binContinuationMode = False

'全レコードを処理
Do Until rsSource.EOF
    If Not binContinuationMode Then
        '新しいコード行の開始
        lngBaseID = rsSource!コードラインID
        strResolvedCode = Trim(rsSource!コード)
        strElementIDList = CStr(lngBaseID)
        intContinuationCount = 0
    Else
        '継続モード中：前行と結合
        strResolvedCode = strResolvedCode & " " & Trim(rsSource!コード)
        strElementIDList = strElementIDList & "," & CStr(rsSource!コードラインID)
        intContinuationCount = intContinuationCount + 1
        
        '無限継続防止（100行を超えたら強制終了）
        If intContinuationCount > C_MAX_CONTINUATION_LINES Then
            MsgBox "警告: 継続文字が" & C_MAX_CONTINUATION_LINES & "行を超えました。強制的に結合します。" & vbCrLf & _
                   "基準ID: " & lngBaseID & vbCrLf & _
                   "継続開始: " & Left(strResolvedCode, 50) & "..."
            binContinuationMode = False
        End If
    End If
    
    '継続文字判定
    If has継続文字(strResolvedCode) Then
        '継続文字がある場合
        strResolvedCode = remove継続文字(strResolvedCode)
        binContinuationMode = True
    Else
        '継続文字がない場合：結合完了
        Call insert継続文字解決後データ(lngBaseID, strElementIDList, strResolvedCode, rsSource)
        binContinuationMode = False
    End If
    
    rsSource.MoveNext
Loop

'最後が継続モードで終わった場合の処理
If binContinuationMode Then
    Call insert継続文字解決後データ(lngBaseID, strElementIDList, strResolvedCode, rsSource)
End If

rsSource.Close
Set rsSource = Nothing
```

End Sub

’–––––––––––––––––––––––––
’プロシージャの概要:
’処理名:継続文字解決後データ挿入
’概要:解決後のデータをt03_継続文字解決後テーブルに挿入
’lngBaseID:基準となるコードラインID
’strIDList:結合された元コードラインIDのリスト
’strResolvedCode:解決後のコード
’rsReference:参照用レコードセット
’–––––––––––––––––––––––––
Sub insert継続文字解決後データ(lngBaseID As Long, strIDList As String, strResolvedCode As String, rsReference As DAO.Recordset)
Dim strSQL As String
Dim rsBaseData As DAO.Recordset
Dim strSelectSQL As String

```
'基準IDの元データを取得
strSelectSQL = "SELECT * FROM t02_事前フィルタリング後 WHERE コードラインID = " & lngBaseID
Set rsBaseData = CurrentDb.OpenRecordset(strSelectSQL)

If Not rsBaseData.EOF Then
    '挿入SQL作成
    strSQL = "INSERT INTO t03_継続文字解決後 ("
    strSQL = strSQL & "元コードラインID群, プロシージャID, モジュール種別, "
    strSQL = strSQL & "モジュール名, プロシージャ名, 解決後コード"
    strSQL = strSQL & ") VALUES ("
    strSQL = strSQL & "'" & strIDList & "', "
    
    If IsNull(rsBaseData!プロシージャID) Then
        strSQL = strSQL & "NULL, "
    Else
        strSQL = strSQL & rsBaseData!プロシージャID & ", "
    End If
    
    strSQL = strSQL & "'" & Replace(rsBaseData!モジュール種別, "'", "''") & "', "
    strSQL = strSQL & "'" & Replace(rsBaseData!モジュール名, "'", "''") & "', "
    strSQL = strSQL & "'" & Replace(rsBaseData!プロシージャ名, "'", "''") & "', "
    strSQL = strSQL & "'" & Replace(strResolvedCode, "'", "''") & "'"
    strSQL = strSQL & ")"
    
    CurrentDb.Execute strSQL
End If

rsBaseData.Close
Set rsBaseData = Nothing
```

End Sub

’–––––––––––––––––––––––––
’プロシージャの概要:
’処理名:継続文字判定
’概要:コード行に継続文字（_）があるかを判定
’strCode:判定対象のコード行
’戻り値:継続文字がある場合True
’–––––––––––––––––––––––––
Function has継続文字(strCode As String) As Boolean
Dim strTrimmedCode As String

```
strTrimmedCode = Trim(strCode)

'空文字チェック
If Len(strTrimmedCode) = 0 Then
    has継続文字 = False
    Exit Function
End If

'末尾が継続文字かチェック
has継続文字 = (Right(strTrimmedCode, 1) = "_")
```

End Function

’–––––––––––––––––––––––––
’プロシージャの概要:
’処理名:継続文字除去
’概要:コード行から継続文字（_）を除去
’strCode:処理対象のコード行
’戻り値:継続文字を除去したコード
’–––––––––––––––––––––––––
Function remove継続文字(strCode As String) As String
Dim strTrimmedCode As String

```
strTrimmedCode = Trim(strCode)

'継続文字がある場合は除去
If has継続文字(strTrimmedCode) Then
    remove継続文字 = Trim(Left(strTrimmedCode, Len(strTrimmedCode) - 1))
Else
    remove継続文字 = strTrimmedCode
End If
```

End Function