Question

我已经看到过像这样的一些问题但是我对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

对我来说这看起来应该有效但运行时没有任何反应。有任何想法吗？（注意：此处的路径将替换为文件路径）

Answer 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

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

1 个答案: