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

Question

好吧，基本上我有一个包含大约 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。

如果只有我一个人这样做，我会一直手动破坏文件，但说完这些后，我需要将这些文件交给委托项目的客户，所以越容易越好。

非常感谢任何想法。

Answer 1

这样的事情可能对你有用。未经测试，但可以编译...

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

Answer 2

因此，在 Tim 的帮助下，这是最终版本，它接受关于每个文件的最大行数的参数，并根据需要输出到尽可能多的子文​​件。

Sub CSVFile()

    Dim MaxRows As Long
    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")
    MaxRows = Application.InputBox(Prompt:="Enter maximum number of rows per file.", _
        Default:=5000, Type:=1)

    '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 And lFile = 1 Then TextHeader = CurrTextStr 'Capture the header row

        Print #1, CurrTextStr

        If lRow > MaxRows 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

我刚刚添加了一个用户输入请求以获取最大行数，并且还对其进行了调整，使其不会使用每个新文件更新标题行。再次感谢您的帮助。