使excel宏的文件扫描更稳定

Question

我很好奇，如果任何人都可以提供关于如何使Excel宏更稳定的建议。

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

它打开Excel文件，扫描列d用于字失败，然后该数据以在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等于这个，现在它等于这个代替，现在它等于这个代替，现在它等于这个代替，等...

您最终得到的结果是之前的参考被覆盖是一种孤立的对象，它在内存中占据了一些空间。

Answer 2

根据您的情况，您可以使用以下，使其更快-by关闭Excel的过程中，你并不真的需要在您的宏execution-

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 
... 

为注释，你永远不设置回screenupdating到真正在你的子，这可能导致在Excel奇怪的行为，你应该把一切都默认你与完成后的 东东。

OT：某些进程无法进一步优化 - 有时候，您正在说什么 - 扫描超过5k个文件？ - 肯定需要一些时间，您需要在如何沟通用户这将需要一段时间 - 而不是应用程序状态栏消息或显示进程的用户窗体？