Question

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

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

打开excel文件，扫描 D列以查找单词 fail ，然后将该行数据复制到excel文件中的数据表，此处编写此宏。

在大多数情况下，宏运行完美，但有时我会遇到运行时错误或者“excel已经停止工作”＃39;错误。我可以一次扫描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

根据您的情况，您可以使用以下内容使其更快 - 通过关闭宏执行时您真正不需要的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以上的文件？ - 当然它需要花一点时间，你需要工作如何沟通需要一段时间的用户 - 也许是应用程序状态栏消息或显示进程的用户表单？ - 。

Answer 2

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

尝试释放/销毁对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 相反，现在它等于这个等等......

您最终使用之前被覆盖的引用作为一种在内存中占有一些空间的孤立对象。

使excel宏文件扫描更加稳定

2 个答案: