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

wdebmtf2 于 2023-11-14 发布在其他

关注(0)|答案(1)|浏览(84)

我有一个宏脚本：

导出多个csv文件，使用A列中的“next”分隔符，直到找到“stop”。
将每个csv文件命名为S列中相应行的文件，“文件1”、“文件2”、“文件3”
xslm顶部的列标题将为每个导出的.csv复制，因此.xlsm文件不需要在“next”之前的每一行都有重复的标题
它确实会转义分隔符，如“;”
它导出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

字符串
我们如何修改这段代码来生成多个文件（我们可以指定要生成多少个文件）。

csv

来源：https://stackoverflow.com/questions/77461365/generate-multiple-csv-files-using-macro-from-xslm-file

1条答案

按热度按时间

wtlkbnrh1#

你的代码快完成了。我做了一些修改。

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 enumeration (Excel)

赞(0）回复(0）举报 2023-11-14

我来回答

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

1条答案

相关问题

热门标签

最新问答