У меня есть процедура, которая может длиться очень долго. Вчера это заняло 14 часов. Этот фрагмент кода циклически обрабатывает значения столбца, который содержит имена файлов изображений, и выполняет поиск в массиве, который содержит все файлы, включая путь, из местоположения, выбранного пользователем. В этом конкретном случае столбец имени файла содержал около 2600 имен файлов и массив для поиска более 12000 записей. (это более 31 миллиона итераций, любые предложения, если это можно улучшить, приветствуются; -))
В этой процедуре я использую 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
Как видите, я добавил два 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 ( Функция фильтра ) Я мог бы избавиться от вложенного цикла, который повторялся более 12000 раз для каждой строки на листе.