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行，并且它做得很好。我想做的是调整上面的脚本如下：

存储要插入每个文件的标题行。
询问用户每个文件应输出多少行。
将-pt＃附加到所选的另存为文件名。
根据需要将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

我刚刚添加了一个用户输入请求以获取最大行数，并且还调整了它，因此它没有更新每个新文件的标题行。再次感谢您的帮助。

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

2 个答案: