Question

这个问题的相似版本以前可能已经被问过，但是我对此问题有疑问。

基本上，对于我的功能，我只想对Microsoft Access中选定的表进行简单的拼写检查。由于Access不支持在报表中单独突出显示所有内容，因此我将数据导出到Excel文件，并让VBA对其中的任何错误进行了测试。在网上搜索提示后，我拥有的当前代码可以比最初运行的更快。但是理想情况下，无论表的大小如何，我都希望函数在10分钟内运行。但是目前对于其中的一些而言，对于具有500k +单元格的表，运行时间仍然可以超过30分钟。因此，我想知道是否可以做进一步的事情来更好地增强其运行时间。

Private Function Excel_Parser(outFile As String, errorCount As Integer, ByVal tName As String)

 ' EXCEL SETUP VARIABLES
 Dim OpenApp As Excel.Application
 Set OpenApp = CreateObject("Excel.Application")

 Dim parserBook As Excel.Workbook
 Dim parserSheet As Excel.Worksheet

 ' Opening exported file
 Set parserBook = OpenApp.Workbooks.Open(outFile, , , , , , , , , , , , , , XlCorruptLoad.xlRepairFile)

 If parserBook Is Nothing Then
    status2 = "Failed to set Workbook"
    Exit Function
 Else

     status3 = "Searching [" & tName & "] for errors"

     Set parserSheet = parserBook.Worksheets(1)

     ' --------------------------------------------------------------------------------
     ' Fetch Table information
     lastCellAddress = parserSheet.Range("A1").SpecialCells(xlCellTypeLastCell).Address

     Dim rng As Range
     Set rng = parserSheet.Range("A1:" & lastCellAddress)
     ' --------------------------------------------------------------------------------

     ' Populating entire table data from Excel into array to save runtime.
     Dim dataArr() As Variant, R As Long, C As Long
     dataArr = rng.Value2

     ' Parsing through table data array
     nRows = UBound(dataArr, 1)
     nCols = UBound(dataArr, 2)

     fileOuterLoop1 = Time

     For R = 1 To nRows

         For C = 1 To nCols

             cCell = CStr(dataArr(R, C))
             status4 = "Now running check on cell: [" & cCell & "]"

             If cCell <> "" Or Not (IsNull(cCell)) Then

                If Not OpenApp.Application.CheckSpelling(cCell) Then

                    errorCount = errorCount + 1

                    ' Change cell status
                    vArr = Split(parserSheet.Cells(1, C).Address(True, False), "$")
                    fCol = vArr(0)
                    xDef = fCol & R
                    parserSheet.Range(xDef).Interior.Color = RGB(255, 213, 124)

                End If

             End If  'End of cCell is null check
         Next C
     Next R

     fileOuterLoop2 = Time
     fCheck = Format(fileOuterLoop2 - fileOuterLoop1, "hh:mm:ss")

     ' --------------------------------------------------------------------------------

     parserSheet.Columns.AutoFit
     status7 = "Loop Finished. Runtime: " & fCheck

     ' Save and Cleanup
     OpenApp.DisplayAlerts = False
     parserBook.SaveAs FileName:=outFile, FileFormat:=xlWorkbookDefault, ConflictResolution:=xlLocalSessionChanges
     parserBook.Saved = True
     parserBook.Close SaveChanges:=False
     OpenApp.DisplayAlerts = True

     Set parserSheet = Nothing
     Set parserBook = Nothing
     Set OpenApp = Nothing

     ' Return errorCount for database
     Excel_Parser = errorCount

 End If

End Function

outFile是PATH字符串，其中TransferSpreadsheet命令中存在文件。 “状态”变量只是“访问”表单中的错误日志文本框。我尝试添加Access和Excel的ScreenUpdating或Echo版本，但是我发现这些命令实际上使我的函数运行速度稍慢。

Answer 1

两件事：

您是否在代码中的某处使用status4来显示当前的工作状态，并在示例中此处省略了它？如果是这样，请考虑不使用Mod运算符在每个循环中都显示它，而是仅每50步显示一次。

请参见https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/mod-operator

您应该避免在Excel的每个循环中进行屏幕刷新和更多操作，方法是在循环之前设置以下内容：

OpenApp.ScreenUpdating = False
OpenApp.EnableEvents = False
OpenApp.Calculation = Excel_XlCalculation.xlCalculationManual

在循环之后：

OpenApp.ScreenUpdating = True
OpenApp.EnableEvents = True
OpenApp.Calculation = Excel_XlCalculation.xlCalculationAutomatic

它可以大大加快速度。试试看。

访问Excel：减少Excel VBA的运行时

1 个答案: