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

我有一个程序可以运行很长时间。昨天花了14个小时才完成。这段代码在保存图像文件名的列的值上循环，并在保存所有文件的数组中搜索，包括来自用户选择的位置的路径。在本例中，filename列包含近2600个文件名和用于搜索12000多条记录的数组。（超过3100万次迭代，如果可以改进，欢迎任何建议；-）

在这个过程中，我使用DoEvents来保持Excel的响应性。但我只是想知道有两个事件是否有意义。每个循环一个（见下面的代码）。所有的处理都是在这段代码中完成的。在这种情况下，它运行了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。但是如果只有一个就足够了，那么什么地方是添加它的最佳位置呢。在主循环或嵌套循环中

更新：

重新阅读本文并明确指出不要使用多个DoEvent。在这种情况下，由于程序运行时间较长，因此必须执行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

---

如上所述，由于使用了过滤器-函数（），我可以去掉嵌套循环，该循环对工作表上的每一行进行了12000次迭代。

我将删除主循环中的

DoEvents

，并保留嵌套循环

顺便说一句，我将在Sub的开头添加

Application.screenUpdate=False

下面的帖子可能会有所帮助

---

一个或多个do事件无法解决基本问题。你可以做很多优化，这些优化会大大加快速度

将excel范围复制到VBA数组（或其他集合对象），这样您就不会多次访问excel

从目标目的地获取目录列表，将文本转换为数组或集合对象，并使用该对象而不是多个磁盘访问来获取单个文件名

使用ArrayList和Scripting.Dictionary（集合对象），这样您就可以使用contains或exists方法来避免进行特定的If-then比较

不要进行单独的磁盘拷贝。创建复制/移动指令列表，在处理完所有数据后，这些指令可以作为shell脚本运行

---

需要14个小时的工作是什么？我认为尽量缩短处理时间是有意义的。如果你在复制文件，这可能需要很长时间

DoEvents

将使Excel具有响应性，但它也会减慢整个过程，因此如果您试图加快速度，请不要使用任何

DoEvents

同意@braX：此处不需要DoEvents。此外，如果只有一个匹配项，则您可能希望退出循环，而不是在整个数组中循环？

内部的
退出
如果ExactMatch，那么
？@SiddharthRout可能有多个匹配项。所以我不能用这个出口来做手术。当然需要DoEvents，因为有一个进度条可以定期更新状态栏。但是我所做的改变提高了性能。1.我试试看。2.我已经这么做了。使用wsh.exec（“cmd/c dir”“”&rootPath&“/b/s”）.StdOut.ReadAll读取整个目录和子目录（这是非常快的）。中的结果将转换为数组。3.四,。我也将对此进行调查。有用的信息++好的建议。我将在此基础上再添加一个。避免多次使用
GetFileName（imgArray（i））
。它只能使用一次。。如果是ExactMatch，则紧跟在
之后，并存储在变量中。不断调用函数
GetFileName
会减慢代码的速度。@SiddharthRout也很好，但是因为我重写了代码，所以我可以得到GetFileName部分的write。