Excel 2010 - 将单个 XSLM 导出到多个 CSV 文件

好吧，基本上我有一个包含大约 40k 行的 XSLM 文件。我需要将这些行导出为自定义的 CSV 格式 - ^ 分隔并 ~ 标记每个单元格的边界。一旦导出，它们就会被 Joomla 导入器应用程序读入并处理到数据库中。我找到了一个很好的宏脚本，它可以做到这一点，并对其进行调整以使用正确的分隔符。

Sub CSVFile()

    Dim SrcRg As Range
    Dim CurrRow As Range
    Dim CurrCell As Range
    Dim CurrTextStr As String
    Dim ListSep As String
    Dim FName As Variant
    FName = Application.GetSaveAsFilename("", "CSV File (*.csv), *.csv")

    'ListSep = Application.International(xlListSeparator)
     ListSep = "^" ' Use ^ as field separator.
    If Selection.Cells.Count > 1 Then
        Set SrcRg = Selection
    Else
        Set SrcRg = ActiveSheet.UsedRange
    End If

    Open FName For Output As #1
    For Each CurrRow In SrcRg.Rows
        CurrTextStr = ìî
        For Each CurrCell In CurrRow.Cells
            CurrTextStr = CurrTextStr & "~" & CurrCell.Value & "~" & ListSep
        Next
        While Right(CurrTextStr, 1) = ListSep
            CurrTextStr = Left(CurrTextStr, Len(CurrTextStr) - 1)
        Wend

        Print #1, CurrTextStr
    Next
    Close #1
End Sub

然而，我发现生成的 CSV 太大，无法用可用的脚本执行时间来处理。我可以手动将文件拆分为每个文件约 5000 行，效果足够好。我想做的是将上面的脚本调整如下：

1. 存储要插入到每个文件中的标题行。
2. 询问用户每个文件应输出多少行。
3. 将 -pt# 附加到所选的另存为文件名。
4. 根据需要将 Excel 文件处理为尽可能多的“块”csv 文件。

例如，如果我的文件名是输出，文件分隔符编号是 5000，Excel 文件有 14000 行，那么我最终会得到output-pt1.csv、output-pt2.csv 和output-pt3.csv。

如果只有我这样做，我只会继续手动破坏文件，但是当一切都说完并完成后，我需要将这些文件交给委托项目的客户，所以越简单越好。

非常感谢任何想法。

像这样的东西可能对你有用。未经测试，但编译...

Sub CSVFile()

    Const MAX_ROWS As Long = 5000
    Dim SrcRg As Range
    Dim CurrRow As Range
    Dim CurrCell As Range
    Dim CurrTextStr As String
    Dim ListSep As String
    Dim FName As Variant, newFName As String
    Dim TextHeader As String, lRow As Long, lFile As Long

    FName = Application.GetSaveAsFilename("", "CSV File (*.csv), *.csv")

    'ListSep = Application.International(xlListSeparator)
    ListSep = "^" ' Use ^ as field separator.
    If Selection.Cells.Count > 1 Then
        Set SrcRg = Selection
    Else
        Set SrcRg = ActiveSheet.UsedRange
    End If

    lRow = 0
    lFile = 1

    newFName = Replace(FName, ".csv", "_pt" & lFile & ".csv")
    Open newFName For Output As #1

    For Each CurrRow In SrcRg.Rows
        lRow = lRow + 1
        CurrTextStr = ""
        For Each CurrCell In CurrRow.Cells
            CurrTextStr = CurrTextStr & "~" & CurrCell.Value & "~" & ListSep
        Next
        While Right(CurrTextStr, 1) = ListSep
            CurrTextStr = Left(CurrTextStr, Len(CurrTextStr) - 1)
        Wend

        If lRow = 1 Then TextHeader = CurrTextStr
        Print #1, CurrTextStr

        If lRow > MAX_ROWS Then
            Close #1
            lFile = lFile + 1
            newFName = Replace(FName, ".csv", "_pt" & lFile & ".csv")
            Open newFName For Output As #1
            Print #1, TextHeader
            lRow = 0
        End If

    Next

    Close #1
End Sub