CSV出力２

```
Sub ExportToMultipleCSVs()
    Dim ws As Worksheet
    Dim outputListSheet As Worksheet
    Dim tableSheet As Worksheet
    Dim targetColumn As Range
    Dim matchRow As Range
    Dim cell As Range
    Dim targetSheets As Collection
    Dim outputFileName As String
    Dim separator As String
    Dim abolishedFlagColumn As Range
    Dim lColumn As Range
    Dim itemDescriptionCell As Range
    Dim startCell As Range, endCell As Range
    Dim dataRange As Range
    Dim visibleRows As Range
    Dim lastRow As Long
    Dim fileNumber As Integer
    Dim rowData As String
    Dim area As Range
    Dim row As Range
    Dim tableRange As Range

    ' 「出力リスト」シートを取得
    On Error Resume Next
    Set outputListSheet = ThisWorkbook.Sheets("出力リスト")
    Set tableSheet = ThisWorkbook.Sheets("テーブルの区切り一覧")
    On Error GoTo 0

    If outputListSheet Is Nothing Then
        MsgBox "出力リストシートが見つかりません。", vbExclamation
        Exit Sub
    End If

    If tableSheet Is Nothing Then
        MsgBox "テーブルの区切り一覧シートが見つかりません。", vbExclamation
        Exit Sub
    End If

    ' 「出力対象」の列を探す
    Set targetColumn = outputListSheet.Cells.Find("出力対象", LookIn:=xlValues, LookAt:=xlWhole)
    If targetColumn Is Nothing Then
        MsgBox "出力対象列が見つかりません。", vbExclamation
        Exit Sub
    End If

    ' ●がついている行の文字列を収集
    Set targetSheets = New Collection
    For Each cell In outputListSheet.Range(targetColumn.Offset(1, 0), outputListSheet.Cells(outputListSheet.Rows.Count, targetColumn.Column).End(xlUp))
        If cell.Value = "●" Then
            targetSheets.Add cell.Offset(0, -1).Value ' 左隣のセルの文字列を収集
        End If
    Next cell

    ' テーブルの区切り一覧の範囲を取得
    Set tableRange = tableSheet.Columns("G:I")

    ' 収集した文字列に対応するシートをCSV出力
    For Each sheetName In targetSheets
        On Error Resume Next
        Set ws = ThisWorkbook.Sheets(sheetName)
        On Error GoTo 0

        If ws Is Nothing Then
            MsgBox "シート " & sheetName & " が見つかりません。", vbExclamation
            GoTo NextSheet
        End If

        ' 区切り文字の取得
        Set matchRow = tableRange.Columns(1).Find(sheetName, LookIn:=xlValues, LookAt:=xlWhole)
        If Not matchRow Is Nothing Then
            separator = matchRow.Offset(0, 2).Value
            separator = Replace(separator, "「", "") ' 左側の「を削除
            separator = Replace(separator, "」", "") ' 右側の」を削除
            separator = Trim(separator) ' 前後の余計な空白を削除
        Else
            MsgBox "区切り文字が見つかりません（シート: " & sheetName & "）。", vbExclamation
            GoTo NextSheet
        End If

        ' 廃止フラグの列を探す
        Set abolishedFlagColumn = ws.Cells.Find("廃止フラグ", LookIn:=xlValues, LookAt:=xlWhole)
        If abolishedFlagColumn Is Nothing Then
            MsgBox "廃止フラグが見つかりません（シート: " & ws.Name & "）。", vbExclamation
            GoTo NextSheet
        End If

        ' Lの列を探す（最後の行を取得）
        Set lColumn = ws.Cells.Find("L", LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlPrevious)
        If lColumn Is Nothing Then
            ' Lが存在しない場合、最後の行をシートの最終行に設定
            lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
        Else
            lastRow = lColumn.Row
        End If

        ' 項目説明のセルを探す
        Set itemDescriptionCell = ws.Cells.Find("項目説明", LookIn:=xlValues, LookAt:=xlWhole)
        If itemDescriptionCell Is Nothing Then
            MsgBox "項目説明が見つかりません（シート: " & ws.Name & "）。", vbExclamation
            GoTo NextSheet
        End If

        ' データ範囲を選択
        Set startCell = itemDescriptionCell.Offset(1, 1) ' 項目説明の下の隣のセル（B列）
        If Not lColumn Is Nothing Then
            Set endCell = ws.Cells(lastRow - 1, abolishedFlagColumn.Column - 1) ' Lがある場合、最後の行の1つ上
        Else
            Set endCell = ws.Cells(lastRow, abolishedFlagColumn.Column - 1) ' Lがない場合、最後の行
        End If
        Set dataRange = ws.Range(startCell, endCell)

        ' フィルタリングされている行のみを取得
        On Error Resume Next
        Set visibleRows = dataRange.SpecialCells(xlCellTypeVisible)
        On Error GoTo 0

        If visibleRows Is Nothing Then
            MsgBox "フィルタリングされたデータがありません（シート: " & ws.Name & "）。", vbExclamation
            GoTo NextSheet
        End If

        ' CSVファイルに出力
        outputFileName = ThisWorkbook.Path & "\" & ws.Name & ".csv"
        fileNumber = FreeFile
        Open outputFileName For Output As #fileNumber

        For Each area In visibleRows.Areas
            For Each row In area.Rows
                rowData = ""
                For Each cell In row.Cells
                    rowData = rowData & cell.Value & separator
                Next cell
                rowData = Left(rowData, Len(rowData) - Len(separator)) ' 最後の区切り文字を削除
                Print #fileNumber, rowData
            Next row
        Next area

        Close #fileNumber

        MsgBox "データが " & outputFileName & " にエクスポートされました。", vbInformation

NextSheet:
        Set ws = Nothing
    Next sheetName

    MsgBox "すべてのCSV出力が完了しました。", vbInformation
End Sub


```