Excel 2010-将单个XSLM导出到多个CSV文件 [英] Excel 2010 - Export single XSLM to multiple CSV Files

问题描述

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

Alright, so, basically I have an XSLM file containing about ~40k rows. I need to export these rows to a customized CSV format - ^ delimited and ~ marking the boundaries of each cell. Once they've been exported, they are read in by a Joomla importer app and processed into the database. I found a good macro script which does just that and tweaked it to use the correct delimiters.

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行，并且效果很好.我想做的是如下调整上面的脚本:

However, what've I've found is that the generated CSVs are simply too big to be handled with the available script execution time. I can split the files manually to about 5000 rows apiece and it does well enough. What I'd like to do is adjust the above script as follows:

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

例如，如果输出了我的文件名，文件中断号是5000，并且excel文件有14000行，我最终将得到output-pt1.csv，output-pt2.csv和output-pt3 .csv.

For example, if my file name was output, the file break number was 5000, and the excel file had 14000 rows, I'd end up with output-pt1.csv, output-pt2.csv, and output-pt3.csv.

如果只是我在做，我会一直手动破坏文件，但是说完一切之后，我需要将这些文件交给客户进行项目调试，这样越容易越好.

If it were just me doing it, I'd just keep breaking the files manually, but when all is said and done I need to hand these files off to the client commissioning the project, so the easier the better.

非常感谢任何想法.

推荐答案

类似的方法可能对您有用.未经测试，但可以编译...

Something like this might work for you. Untested, but compiles...

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

这篇关于Excel 2010-将单个XSLM导出到多个CSV文件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！