csv出力１

Sub ExportToCSV()
    Dim ws As Worksheet
    Dim tableSheet As Worksheet
    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 outputFileName As String
    Dim fileNumber As Integer
    Dim rowData As String
    Dim cell As Range
    Dim lastRow As Long
    Dim area As Range
    Dim row As Range
    Dim sheetName As String
    Dim separator As String
    Dim tableRange As Range
    Dim matchRow As Range

    ' 開いているシートを対象に処理
    Set ws = ActiveSheet

    If ws Is Nothing Then
        MsgBox "アクティブなシートが見つかりません。処理を終了します。", vbExclamation
        Exit Sub
    End If

    ' 開いているシート名を取得
    sheetName = ws.Name

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

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

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

    ' シート名を比較して区切り文字を取得
    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 "テーブルの区切り一覧に一致するシート名が見つかりません。", vbExclamation
        Exit Sub
    End If

    ' 廃止フラグの列を探す
    Set abolishedFlagColumn = ws.Cells.Find("廃止フラグ", LookIn:=xlValues, LookAt:=xlWhole)
    If abolishedFlagColumn Is Nothing Then
        MsgBox "廃止フラグが見つかりません。", vbExclamation
        Exit Sub
    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 "項目説明が見つかりません。", vbExclamation
        Exit Sub
    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 "フィルタリングされたデータがありません。", vbExclamation
        Exit Sub
    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
End Sub