Excel VBA Macro копия файла между каталогами

Question

Мне нужна помощь, чтобы сделать этот код более быстрым. В настоящее время он работает как меласса, слишком медленный, чтобы быть практичным.

Эта программа предназначена для сравнения каждого файла в каталоге файлов со списком имен файлов. Файлы перечислены в подкаталогах в соответствии с датой их создания, поэтому типичный путь к файлу может выглядеть как> 16> 06> 27> example.wav. Список имен файлов, которые мне нужно скопировать в другой каталог, находится в Sheet1, столбец R.

Я начал этот проект в Excel 2010 и обновил до 64-разрядной версии Excel 2016, чтобы воспользоваться расширенным виртуальным памяти в этой версии Office, но она все еще работает ОЧЕНЬ медленно и сбой, прежде чем программа завершится.

Как папка, где хранятся файлы, так и папка, в которую я их копирую, находятся на сетевом диске, хранящемся на сервере офиса. Это вызывает проблему? Я что-то не так с кодом? Я не могу представить себе компьютер с мощью под капотом, который у меня сталкивается с проблемами с парой вложенных циклов For и двоичного поиска.

Sub CopyFile() 
Application.Calculation = xlCalculationManual 'trying to speed things up. 
ActiveSheet.DisplayPageBreaks = False 

'This code takes the directory where the files are stored from the Active worksheet Range B3 and the goal directory where the copies are to be stored from Range G3 
'It then lists all of the subdirectories (months) of the year we start with in column B, 
'all of the days of that month in Column C and all the files in a given day in column D. 

'List all the months in Column B 
ListFilesinFolder ("B") 'lists the months in the year directory 

With ActiveSheet 
For i = 6 To Range("B6", Range("B6").End(xlDown)).Rows.Count + 5 
    Range("B3") = Range("B3") & Range("B" & i) & "\" 'Add the month to the folder name 
    ListFilesinFolder ("C") 'List all of the days in the month in Column C 

    For x = 6 To Range("C6", Range("C6").End(xlDown)).Rows.Count + 5 

     Range("B3") = Range("B3") & Range("C" & x) & "\" 'Add the day to the folder name 
     ListFilesinFolder ("D") 'List all of the files in column D 

     For y = Range("D6", Range("D6").End(xlDown)).Rows.Count + 5 To 6 Step -1 

      binarySearch (y) 'Search for the filename against our list of potential filenames in Sheet1 column R 

     Next y 

     Range("D6", Range("D6").End(xlDown)).ClearContents 
     Range("B3") = Left(Range("B3"), 23) 'Get the folder name in B3 back to year and month 

    Next x 

    Range("C6", Range("C6").End(xlDown)).ClearContents 
    Range("B3") = Left(Range("B3"), 20) 'Get the folder name in B3 back to just the year 
Next i 
End With 

Application.Calculation = xlCalculationAutomatic 

End Sub 

Sub ListFilesinFolder(ColName As String) 'lists all the files or sub-directories in a folder in the column passed to this function. 
    Dim Value As String 
    Dim strt As Range 
    Set strt = Range(ColName & "6") 
    Value = Dir(Range("B3"), &H1F) 
    Do Until Value = "" 
    If Value <> "." And Value <> ".." Then 
     strt = Value 
     Set strt = strt.Offset(1, 0) 
    End If 
    Value = Dir 
    Loop 
End Sub 

Sub binarySearch(index As Long) 
Dim low As Double 
Dim mid As Long 
Dim high As Double 
Dim sheetNotesInfo As Worksheet 
Dim src As String, dst As String, fl As String 

'Source directory 
src = Range("B3") 
'Destination directory 
dst = Range("G3") 
'File name 
fl = Range("B6") 

'sheet with potential file names 
Set sheetNotesInfo = ActiveWorkbook.Sheets("Sheet1") 

low = 2 
high = sheetNotesInfo.UsedRange.Rows.Count 

      Do While (low <= high) 

       mid = (low + high)/2 

       If (sheetNotesInfo.Range("R" & mid) > Left(Range("D" & index), 19)) Then 
        high = mid - 1 

       ElseIf (sheetNotesInfo.Range("R" & mid) < Left(Range("D" & index), 19)) Then 
        low = mid + 1 

       Else 'found 
       src = Range("B3") 'setting the source of the file to be the source folder 
       fl = Range("D" & index) 'setting the filename to be the filename we are currently inspecting 

       On Error Resume Next 
        FileCopy src & "\" & fl, dst & "\" & fl 
        If Err.Number <> 0 Then 
        End If 
       On Error GoTo 0 
       low = 1 
       high = -1 
       End If 
      Loop 

End Sub 

Answer 1

Я думаю, что понял. Я хоть как-то работал.

Проблема была связана с Range("ExampleRange", Range("ExampleRange").End(xlDown)).Rows.Count в тех случаях, когда в этой колонке не было содержимого. В тех случаях, когда в столбце не было содержимого, индекс моего цикла for получал значение ... например, «1048576», а затем цикл до 6 и выполнял двоичный поиск в каждой пустой ячейке между ними.

Так что да. Loooots потраченных впустую временных циклов и вычислений, которые были совершенно бесполезны. Неправильная отладка с моей стороны.

Я установил его с помощью простого оператора If, проверяющего, была ли в первой ячейке в столбце что-либо в нем, а если нет, то выход из цикла For.

If Not Range("ExampleRange") = "" Then 

    binarySearch (y) 'Search for the filename against our list of potential filenames in Sheet1 column R 

Else 

    Exit For 

End If