使文件扫描的excel宏更稳定

Question

我很好奇是否有人可以提供有关如何使 Excel 宏更稳定的建议。

宏提示用户输入包含要扫描文件的文件夹的路径。然后，宏会针对此文件夹中的每个文件进行迭代。

它打开 excel 文件，扫描 D 列 中的单词 fail，然后将该行数据复制到 excel 文件的数据表中，该宏在其中编程.

在大多数情况下，宏运行完美，但有时我会遇到运行时错误或“excel 已停止工作”错误。我一次可以扫描 5000 多个文件，宏需要一段时间才能运行。

任何建议将不胜感激。谢谢！

Sub findFail()    

Dim pathInput As String 'path to file
Dim path As String 'path to file after being validated
Dim fileNames As String 'path to test file

Dim book As Workbook 'file being tested
Dim sheet As Worksheet 'sheet writting data to
Dim sh As Worksheet 'worksheet being tested
Dim dataBook As Workbook 'where data is recorded

Dim row As Long 'row to start writting data in
Dim numTests As Long 'number of files tested
Dim j As Long 'counter for number of files tested
Dim i As Long 'row currently being tested
Dim lastRow As Long 'last row used

Dim startTime   As Double 'time when program started
Dim minsElapsed As Double 'time it took program to end

Application.ScreenUpdating = False

j = 0
i = 1
row = 2

Set dataBook = ActiveWorkbook
Set sheet = Worksheets("Data")
sheet.Range("A2:i1000").Clear

startTime = Timer

'-----Prompt for Path-----

pathInput = InputBox(Prompt:="Enter path to files. It must have a \ after folder name.", _
                     Title:="Single Report", _
                     Default:="C:\Folder\")
If pathInput = "C:\Folder\" Or pathInput = vbNullString Then 'check to make sure path was inputed
    MsgBox ("Please enter a valid file path and try again.")
    Exit Sub
Else
    path = pathInput 'path = "C:\Temp\212458481\" ' Path for file location
    fileNames = Dir(path & "*.xls")   'for xl2007  & "*.xls?" on windows
'-----begin testing-----
    Do While fileNames <> "" 'Loop until filename is blank
        Set book = Workbooks.Open(path & fileNames)
        Set sh = book.Worksheets(1)
        lastRow = sh.UsedRange.Rows(sh.UsedRange.Rows.Count).row

        If sh.Cells(lastRow, 2).Value - sh.Cells(1, 2).Value >= 0.08333333 Then
            Do While sh.Range("D" & i).Value <> "" 'loop untile there are no rows left to test
                If sh.Range("D" & i).Value = "Fail" Then 'record values if test result is false
                    sheet.Range("A" & row).Value = book.Name
                    sheet.Range("B" & row).Value = Format(sh.Range("B" & i).Value - sh.Range("B1").Value, "h:mm:ss")
                    sheet.Range("C" & row).Value = sh.Range("A" & i).Value
                    sheet.Range("D" & row).Value = Format(sh.Range("B" & i).Value, "h:mm:ss")
                    sheet.Range("E" & row).Value = sh.Range("C" & i).Value
                    sheet.Range("F" & row).Value = sh.Range("D" & i).Value
                    sheet.Range("G" & row).Value = sh.Range("E" & i).Value
                    sheet.Range("H" & row).Value = sh.Range("F" & i).Value
                    sheet.Range("I" & row).Value = sh.Range("G" & i).Value
                    row = row + 1
                    Exit Do
                End If
                i = i + 1
            Loop
            j = j + 1
            dataBook.Sheets("Summary").Cells(2, 1).Value = j
        End If
        book.Close SaveChanges:=False
        fileNames = Dir()
        i = 1
    Loop
numTests = j
Worksheets("Summary").Cells(2, "A").Value = numTests

minsElapsed = Timer - startTime
Worksheets("Summary").Cells(2, "B").Value = Format(minsElapsed / 86400, "hh:mm:ss")
End If

End Sub

Answer 1

如果没有与您相同的数据集，我们无法明确提供答案，但我可以推荐以下与您看到的错误相关的内容。

尝试释放/销毁对book 和sh 的引用。

你有一个设置它们的循环：-

Do While fileNames <> "" 'Loop until filename is blank
    Set book = Workbooks.Open(path & fileNames)
    Set sh = book.Worksheets(1)

但是循环结束并没有清除它们，理想情况下它应该如下所示：-

    Set sh = Nothing
    Set book = Nothing
Loop

这是一种更好的资源处理方式，应该可以提高内存使用率。

作为一个糟糕的例子，如果没有它，您的代码会说，sh 等于 this，现在它等于 this，现在它等于 this em> 代替，现在它等于 this 代替，等等...

您最终会得到先前的引用，该引用随后被覆盖，成为一种在内存中保留一些空间的孤立对象。

Answer 2

根据您的情况，您可以使用以下方法来加快速度 - 通过关闭执行宏时不需要的 excel 进程 -

Sub ExcelBusy()
        With Excel.Application
        .Cursor = xlWait
        .ScreenUpdating = False
        .DisplayAlerts = False
        .StatusBar = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
        End With
End Sub

在你的子

Dim startTime   As Double 'time when program started
Dim minsElapsed As Double 'time it took program to end

Call ExcelBusy
...

作为评论，您从未在您的 sub 中将 screenupdating 设置为 true，这可能会导致 excel 中出现奇怪的行为，您应该在完成您的工作后将所有内容设置为默认值。

OT：某些进程无法进一步优化 - 有时 - 就您所说的 - 扫描 5k 文件？- 当然这需要一些时间，您需要研究如何与需要一段时间的用户 - 也许是应用程序状态栏消息或显示过程的用户表单？-.