在嵌套循环中使用多个 DoEvent 在 Excel VBA 中是否有意义？

Question

我有一个程序可以运行很长。昨天花了 14 个小时才完成。这段代码循环遍历包含图像文件名的列的值，并搜索包含所有文件的数组，包括用户选择的位置的路径。在这种特殊情况下，文件名列包含近 2600 个文件名和用于搜索超过 12000 条记录的数组。（超过 3100 万次迭代，如果可以改进，欢迎提出任何建议 ;-)）

在此过程中，我使用 DoEvents 来保持 Excel 响应。但我只是想知道有两个 DoEvents 是否有意义。每个循环中一个（见下面的代码）。所有的处理都是在这段代码中完成的。在这种情况下运行超过 14 小时。

 For Each cell In ActiveSheet.Range("A1:A" & Range("A1").End(xlDown).row)
        DoEvents
        fileCopied = False
        fileName = cell.Value

        If Not (IsStringEmpty(fileName)) Then
            DoEvents
            For i = LBound(imgArray) To UBound(imgArray)
                If Not (IsStringEmpty(CStr(imgArray(i)))) Then
                    If ExactMatch Then
                        If (fsoGetFileName(imgArray(i)) = fileName) Then
                            If DoesFileExist(moveToPath & GetFileName(imgArray(i))) And Not OverwriteExistingFile Then
                                FileCopy imgArray(i), moveToPath & GetFileName(imgArray(i)) & "-" & Format(Now, "yyyymmddhhmmss")
                            Else
                                FileCopy imgArray(i), moveToPath & GetFileName(imgArray(i))
                            End If
                            fileCopied = True

                            If fileCopied Then
                                If fileCopied Then
                                    Range("B" & cell.row).Value = imgArray(i)
                                End If
                            End If
                        End If
                    End If
                End If
            Next i
        End If
    Next

如您所见，我添加了两个 DoEvent。但是，如果只有一个就足够了，那么添加它的最佳位置是什么。在主循环或嵌套循环中。

更新：

重新阅读文章 DoEvents and DoEvents (automateexcel) 明确指出不要使用多个 DoEvent。由于长运行ning 过程，DoEvents 在这种情况下是必需的。但我现在不会在每次迭代时都调用它。按照建议我使用：

If i Mod 100 = 0 Then DoEvents

更新：

感谢 FreeFlow，我能够获得显着的性能改进。通过使用可用的过滤器功能而不是遍历包含超过 12000 条记录的数组。使用过滤功能，将处理速度从数小时缩短至数秒。

更新：

最后的结果是：

 fileNameString = GetFilesUsingCMD(filePath)

If Not (IsStringEmpty(fileNameString)) Then
    Dim imgArray As Variant: imgArray = Split(fileNameString, "|")
    rowCount = ActiveSheet.Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count

    fileNameArray = Application.Transpose(ActiveSheet.Range("A:A"))
    activeRow = 0

    For fn = LBound(fileNameArray) To UBound(fileNameArray)
        fileName = fileNameArray(fn)

        If Not (IsStringEmpty(fileName)) Then
            If fn Mod 10 = 0 Then
                Progress.Update fn, rowCount, "(Nr. of files:" & CStr(UBound(imgArray)) & ") Executing time: " & CStr(Format((Timer - StartTime) / 86400, "hh:mm:ss")), fileName, True
                DoEvents
            End If

            If Not ExactMatch Then
                resultArray = Filter(imgArray, fileName, True, vbTextCompare)
            Else
                resultArray = Filter(imgArray, fileName)
            End If

            If (UBound(resultArray) > -1) Then

                For i = LBound(resultArray) To UBound(resultArray)

                    If Not OverwriteExistingFile Then
                        If i = 0 Then
                            newFileName = GetFileName(resultArray(i))
                        Else
                            newFileName = CreateFileName(GetFileName(resultArray(i)), CStr(i))
                        End If
                    Else
                        newFileName = GetFileName(resultArray(i))
                    End If
                    FileCopy resultArray(i), moveToPath & newFileName

                    If Not OrgLocationAsLink Then
                        ActiveSheet.Cells(fn, i + 2).Value = imgArray(i) & " (" & newFileName & ")"
                    Else
                        ActiveSheet.Hyperlinks.Add ActiveSheet.Cells(fn, i + 2), Address:=resultArray(i)
                    End If

                Next i

            Else
                ActiveSheet.Range("B" & fn).Value = "** NOT Available **"
                ActiveSheet.Range("B" & fn).Font.Color = RGB(250, 0, 0)
            End If
        End If
    Next fn
End If

如前所述，由于 Filter-函数 (Filter Function)，我可以摆脱嵌套循环，该循环在 sheet.

Answer 1

我会删除主循环中的 DoEvents，并保留嵌套循环一。

对了，我会在Sub.

开头加上Application.ScreenUpdating = False

下面的 post 可能会有所帮助。

https://wellsr.com/vba/2018/excel/vba-doevents-and-when-to-use-it/

Answer 2

一个或多个do事件解决不了基本问题。您可以进行许多优化，这将极大地加快速度。

将 excel 范围复制到 VBA 数组（或其他集合对象），这样您就不会多次访问 Excel.
从目标位置获取目录列表，将文本转换为数组或集合对象并使用它而不是多次访问磁盘来获取单个文件名。
使用 ArrayLists 和 Scripting.Dictionaries（集合对象），这样您就可以使用 contains 或 exists 方法来避免进行特定的 If then 比较。
不要做单独的磁盘拷贝。创建一个 copy/move 指令列表，当您处理完所有数据后，这些指令可以运行作为 shell 脚本。

在嵌套循环中使用多个 DoEvent 在 Excel VBA 中是否有意义？

Does using multiple DoEvents in a nested loop make any sense in Excel VBA?

excel

vba

doevents