使用 .xslm 文件中的宏生成多个 CSV 文件

Generate multiple CSV files using macro from .xslm file

提问人:Hassan Shehzad 提问时间:11/11/2023 最后编辑:Mayukh BhattacharyaHassan Shehzad 更新时间:11/11/2023 访问量:71

问:

我有宏脚本:

  • 使用 A 列中的“next”分隔符导出多个 csv 文件,直到找到“stop”。
  • 保存每个 csv 文件,其中包含 S 列中的名称文件,对应的行,“文件 1”、“文件 2”、“文件 3”
  • 对于每个导出的 .csv,都会复制 .xslm 顶部的列标题,因此 .xlsm 文件不需要在“下一个”之前的每一行中都有重复的标题
  • 它确实转义了像“;”这样的分隔符
  • 它导出 Unicode 符号
  • 它生成CSV文件。

我希望脚本生成多个具有上述相同要求的文件。

下面是宏代码:

Sub export_multiple_CSV()
    Dim MyFileName As String
    Dim CurrentWB As Workbook, TempWB As Workbook
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim wsCopyRange As Range

    Application.ScreenUpdating = False

    Set CurrentWB = ActiveWorkbook

    On Error Resume Next
    Set ws = CurrentWB.Sheets("File")
    On Error GoTo 0

    If ws Is Nothing Then
        MsgBox "The 'File' sheet is missing!"
        Application.ScreenUpdating = True
        Exit Sub
    Else
        lastRow = ws.UsedRange.rows.count
        Set wsCopyRange = ws.UsedRange
    End If

    ' Initialize variables
    Dim sRow As Long, eRow As Long
    Dim counter As Long: counter = 1
    Dim inSection As Boolean: inSection = False

    ' Loop through each row in column A
    For sRow = 1 To lastRow
        If ws.Cells(sRow, 1).value = "next" Then
            inSection = True
            eRow = sRow - 1
            ' Check if we are at the last row
            If sRow = lastRow Then
                eRow = lastRow
            End If
        ElseIf ws.Cells(sRow, 1).value = "stop" Then
            ' Check if we are in a section
            If inSection Then
                ' Create a temporary workbook and copy the range
                Set TempWB = Application.Workbooks.Add(1)
                wsCopyRange.Offset(eRow).Resize(sRow - eRow).Copy
                With TempWB.Sheets(1).Range("A1")
                    .PasteSpecial xlPasteValues
                    ' Replace add block here
                End With
                Application.CutCopyMode = False

                ' Generate the filename from column S
                Dim fName As String: fName = ws.Cells(eRow, 19).value & "_file" & counter & ".csv"
                MyFileName = CurrentWB.Path & "\" & fName

                ' Save the workbook as CSV with UTF-8 encoding
                TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False
                'SaveAsUTF8 MyFileName

                TempWB.Close SaveChanges:=False
                counter = counter + 1
                inSection = False
            End If
        End If
    Next sRow

    Application.ScreenUpdating = True
End Sub

我们怎样才能修改这段代码来生成多个文件(我们可以指定要生成多少个文件)。

Excel VBA CSV

评论

0赞 taller 11/11/2023
请澄清 的含义。它是一行,其中有或?corresponding rownextstop
0赞 CDP1802 11/11/2023
使用包含递增计数器的块重复该行。TempWB.SaveAs ..For 1 to n: ... :Next

答:

0赞 taller 11/11/2023 #1

您的代码已接近完成。我做了一些改变。

Option Explicit
Sub export_multiple_CSV()
    Dim MyFileName As String
    Dim CurrentWB As Workbook, TempWB As Workbook
    Dim ws As Worksheet
    Dim lastRow As Long, ColCount As Long
    Dim wsCopyRange As Range
    Application.ScreenUpdating = False
    Set CurrentWB = ActiveWorkbook
    On Error Resume Next
    Set ws = CurrentWB.Sheets("File")
    On Error GoTo 0
    If ws Is Nothing Then
        MsgBox "The 'File' sheet is missing!"
        Application.ScreenUpdating = True
        Exit Sub
    Else
        Set wsCopyRange = ws.UsedRange
        ' Get rows # and columns #
        lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
        ColCount = ws.Cells(1, ws.Columns.Count).End(xlToRight).Column
    End If
    ' Initialize variables
    Dim sRow As Long, eRow As Long
    Dim counter As Long: counter = 0
    Dim inSection As Boolean: inSection = False
    ' Loop through each row in column A
    For sRow = 1 To lastRow
        If ws.Cells(sRow, 1).Value = "next" Then
            inSection = True
            eRow = sRow 
        ElseIf ws.Cells(sRow, 1).Value = "stop" Then
            ' Check if we are in a section
            If inSection Then
                ' Create a temporary workbook and copy the range
                Set TempWB = Application.Workbooks.Add(1)
                ' Assign value is more efficient than copy / paste
                With TempWB.Sheets(1)
                    .Range("A1:A" & ColCount).Value = wsCopyRange.Range("A1:A" & ColCount).Value
                    .Range("A2").Resize(sRow - eRow - 1, ColCount).Value = wsCopyRange.Offset(eRow).Resize(sRow - eRow - 1, ColCount).Value
                End With
                Application.CutCopyMode = False
                ' Generate the filename from column S (at "next" row) **modify as needed if filename is in other row
                Dim fName As String: fName = ws.Cells(eRow, 19).Value & "_file" & counter & ".csv"
                MyFileName = CurrentWB.Path & "\" & fName
                ' Save the workbook as CSV with UTF-8 encoding, ** xlCSVUTF8 for UTF8 csv
                TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSVUTF8, CreateBackup:=False
                TempWB.Close SaveChanges:=False
                counter = counter + 1
                inSection = False
            End If
        End If
    Next sRow
    MsgBox "Export " & counter & " csv files."
    Application.ScreenUpdating = True
End Sub

Microsoft 文档:

XlFileFormat 枚举 (Excel)

评论

0赞 Hassan Shehzad 11/11/2023
VBA 是否识别“xlCSVUTF8”。正如它所说,当我运行时没有声明变量。
0赞 taller 11/11/2023
是的。现在是 62 岁。Microsoft文档:> XlFileFormat 枚举 (Excel)。如果你做什么,那么你应该使用。您是否使用 Excel VBA 运行代码?save the workbook as CSV with UTF-8 encodingFileFormat:=xlCSVUTF8
0赞 Hassan Shehzad 11/11/2023
哦,我明白了。谢谢,但您提供的代码不符合我上面提到的要求。
0赞 taller 11/11/2023
我可以知道哪些要求吗?您介意在帖子中分享示例数据以进行测试吗?
0赞 Hassan Shehzad 11/11/2023
我不确定数据,但这些是要求: 使用A列中的“下一个”分隔符导出多个csv文件,直到找到“stop”。为每个导出的 .csv 复制 .xslm 顶部的列标题,因此 .xlsm 文件不需要在“next”之前的每一行中都有重复的标题,它确实转义了分隔符,例如“;”它导出 Unicode 符号 我上面的代码可以满足所有要求,除了生成多个文件。