vba - 如何将Excel拆分为多个具有固定行数的工作簿

Question

我刚刚开始学习 VBA，但还不太习惯这些代码。

任何人都可以帮助我如何根据行数将 Excel 文件拆分为多个工作簿吗？我有大约 14k 个 Excel 文件，需要将它们合并到不到 10 个工作簿中。

在此整合过程中，我想设置一个条件，其中 1 个工作簿最多只有 80k 行，并且下一个数据将复制到新工作簿 (Book2) 中。

以下是我的合并代码，但是我可以在哪里插入行条件？

Sub MergeFiles()
Dim path As String, ThisWB As String, lngFilecounter As Long
Dim wbDest As Workbook, shtDest As Worksheet, ws As Worksheet
Dim Filename As String, Wkb As Workbook
Dim CopyRng As Range, Dest As Range
Dim RowofCopySheet As Integer

CurrFilename = ThisWorkbook.FullName

ary = Split(CurrFilename, "\")
bry = Split(ary(UBound(ary)), ".")
ary(UBound(ary)) = ""
CurrFilename2 = bry(0)

Selection.SpecialCells(xlCellTypeLastCell).Select
CurrTheLastRow = ActiveCell.Row
Range("A1:A" & CurrTheLastRow) = CurrFilename2

RowofCopySheet = 2

ThisWB = ActiveWorkbook.Name

path = InputBox("Enter file path")

Application.EnableEvents = False
Application.ScreenUpdating = False

Set shtDest = ActiveWorkbook.Sheets(1)
Filename = Dir(path & "\*.xls", vbNormal)
If Len(Filename) = 0 Then Exit Sub
Do Until Filename = vbNullString
    If Not Filename = ThisWB Then
        Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)

        ary = Split(Filename, "\")
        bry = Split(ary(UBound(ary)), ".")
        ary(UBound(ary)) = ""
        Filename2 = bry(0)


        Selection.SpecialCells(xlCellTypeLastCell).Select
        TheLastRow = ActiveCell.Row
        Range("A1:A" & TheLastRow) = Filename2

        Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
        Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
        CopyRng.Copy Dest
        Wkb.Close False
    End If

    Filename = Dir()
Loop

Range("A1").Select

Application.EnableEvents = True
Application.ScreenUpdating = True

MsgBox "Done!"
End Sub

Answer 1

既然你熟悉VBA，我就给你一些伪代码。

我的做法是这样的:

循环遍历每个工作簿，在嵌套循环中，我将迭代直到工作簿的最后一行，在复制的每一行上，我将增加一些Long值，当它达到80k时，我将关闭当前工作簿，我们复制到其中，创建另一个并将计数器归零:

If someLongValue = 80000 Then
    'close workbook
    'create another one
    someLongValue = 0
End If

此外，您可以使用文件对话框，而不是在 InputBox 中输入路径，请参阅: https://msdn.microsoft.com/en-us/vba/excel-vba/articles/application-filedialog-property-excel