Question

我已经构建了一个Excel宏，它从所选文件夹中的所有XLS文件中获取第一张纸（包括任何子文件夹中的XLS文件），并将这些纸张复制到新工作簿中的单张纸上。代码似乎在大多数情况下工作正常，我打算用它将数千个Excel工作表合并到一个文件中。

然而问题是循环在某个时刻停止工作，没有引发错误。有时它有几百个文件，有时甚至更多。但这个过程似乎不可靠，我不知道为什么。

这是我的代码（我调用Merge宏，后者又调用DoFolder Sub）：

Sub Merge()
    Dim FileSystem As Object
    Dim HostFolder As String
    HostFolder = "C:\XLSfiles"
    Set FileSystem = CreateObject("Scripting.FileSystemObject")
    DoFolder FileSystem.GetFolder(HostFolder)
End Sub
Sub DoFolder(Folder)
    Dim unusedRow As Long 'used for writing the file path info before each copied sheet
    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
    RowofCopySheet = 2 ' Row to start on in the sheets you are copying from
    ThisWB = ActiveWorkbook.Name
    Set shtDest = ActiveWorkbook.Sheets(1)
    Dim SubFolder
        For Each SubFolder In Folder.SubFolders
        DoFolder SubFolder
    Next
    Dim File
    ActiveWindow.WindowState = xlMinimized
    For Each File In Folder.Files
        ' Operate on each file
        unusedRow = Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Row
        If Not Filename = ThisWB Then
            Set Wkb = Workbooks.Open(File)
            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
        Cells(unusedRow, 1) = File
        Application.StatusBar = File
    Next
    Range("A1").Select
End Sub

我错过了什么？

Answer 1

试试这个：

您可以简单地设置其值
使用多张纸时请勿使用Cells;始终明确说明您想要解决其单元格的对象/工作表

适合我的样本：

For Each fi In f.Files
    If InStr(1, Right(fi.Name, 5), ".xls") > 0 Then

        Set Wkb = Workbooks.Open(fi)
        Set ws = Wkb.Sheets(1)

        rowCount = ws.UsedRange.Rows.Count
        colCount = ws.UsedRange.Columns.Count

        ranString = shtDest.Cells(curRow, 1).Address & ":" & shtDest.Cells(curRow + rowCount, colCount).Address
        Set ran = ws.Range(ws.Cells(2, 1).Address, ws.Cells(rowCount, colCount).Address)
        Set destRan = shtDest.Range(ranString)
        destRan.Value = ran.Value
        curRow = curRow + rowCount

        Wkb.Close False
    End If
Next fi

首先建立一个范围字符串可能看起来有点啰嗦，但它使调试更容易。

Excel循环停止工作

1 个答案: