0

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

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

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

更新：

重读文章DoEvents和DoEvents (automateexcel)明确不要使用多个 DoEvents。在这种情况下，由于需要长时间运行，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），我可以摆脱嵌套循环，该循环为工作表上的每一行迭代超过 12000 次。

4

2 回答 2

1

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

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

  2. 从目标位置获取目录列表，将文本转换为数组或集合对象并使用它而不是多次磁盘访问来获取单个文件名。

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

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

于 2019-11-02T10:49:59.423 回答
0

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

顺便说一句，我会Application.ScreenUpdating = False在 Sub 的开头添加。

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

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

于 2019-11-02T09:48:40.853 回答