将 Excel 拆分为单独的 CSV 文件 - VBA 宏答案

【问题标题】：Split Excel into Separate CSV Files - VBA Macro将 Excel 拆分为单独的 CSV 文件 - VBA 宏
【发布时间】：2015-01-29 13:19:54
【问题描述】：

我见过一些类似这样的问题，但我对 VBA 的了解还不够，无法根据我的要求自定义代码。基本上，我有一个包含 100,000 行的电子表格，我需要将电子表格拆分为 2,000 行的 CSV 格式文件（总共 50 个 CSV 文件）。但是，每个文件都必须包含原始电子表格顶部的“标题行”（名字、姓氏、电子邮件等）。有人可以帮助我使用 VBA 宏来完成此操作吗？我忘了输入到目前为止的代码：

Public Sub Split_2000_With_Column_Headings()

Dim inputFile As String, inputWb As Workbook
Dim lastRow As Long, row As Long, n As Long
Dim newCSV As Workbook

inputFile = "PATH GOES HERE"

Set inputWb = Workbooks.Open(inputFile)

With inputWb.Worksheets(1)
    lastRow = .Cells(Rows.Count, "A").End(xlUp).row

    Set newCSV = Workbooks.Add

    n = 0
    For row = 2 To lastRow Step 2000
        n = n + 1
        .Rows(1).EntireRow.Copy newCSV.Worksheets(1).Range("A1")
        .Rows(row & ":" & row + 2000 - 1).EntireRow.Copy newCSV.Worksheets(1).Range("A2")

        'Save in same folder as input workbook with .xlsx replaced by (n).csv
        newCSV.SaveAs Filename:=Replace(inputWb.FullName, ".xlsx", "(" & n & ").csv"), FileFormat:=xlCSV, CreateBackup:=False
    Next
End With

newCSV.Close saveChanges:=False
inputWb.Close saveChanges:=False
End Sub

对我来说，这似乎应该可以工作，但是当我运行它时没有任何反应。有任何想法吗？（注意：PATH GOES HERE 替换为文件路径）

【问题讨论】：

很高兴了解您到目前为止所做的工作，请问您可以分享您当前的代码吗？
我刚刚添加了它，对此感到抱歉。
好的，我找到了问题所在。我使用了错误的格式。但是，现在当我尝试运行脚本时，如果 A 列的单元格中没有任何内容，它就会停止。知道这是为什么吗？
该代码对我来说工作正常并产生预期的结果，我也没有在代码中看到任何错误。我使用 Excel 2010 创建了一个包含 3 列和 100,000 行的 Data.xlsx。将上述代码复制到一个新工作簿中，并将“PATH GOES HERE”替换为实际路径。完成代码后，我有 50 个新的 csv 文件，即 Data(1).csv 到 Data(50).csv，每个文件有 2000 条记录，标题位于同一文件夹中。不知道为什么它不适合你？您是否看到任何错误消息？
您正在根据 A 列 lastRow = .Cells(Rows.Count, "A").End(xlUp).row 找到最后一行，因此如果 A 列为空，它显然不会进入循环并且不会产生任何结果。

标签： vba excel csv

【解决方案1】：

有类似的需求，并且 OP 的解决方案有效，只是我确实将新 CSV 的打开和关闭放在循环中，以免 Excel 崩溃：

    For row = 1 To lastRow Step 2000

        'add workbook inside the loop
        Set newCSV = Workbooks.Add

        n = n + 1

        .Rows(row & ":" & row + 2000 - 1).EntireRow.Copy newCSV.Worksheets(1).Range("A1")

        'save in same folder as input workbook with .xlsx replaced by (n).csv
        newCSV.SaveAs Filename:=Replace(inputWb.FullName, ".xlsx", "(" & n & ").csv"), FileFormat:=xlCSV, CreateBackup:=False

        'close workbook inside the loop
        newCSV.Close saveChanges:=False

    Next

【讨论】：