Два одинаковых файла лежат в разных папках. Макросы "Дата" определяют дату последнего изменения каждого из них. Если даты разные (значение ИСТИНА в столбце F - формула), то более новый файл открывается и пересохраняется вместо старого. Так как таких файлов 20, процесс занимает длительное время. Подскажите, пожалуйста, можно ли как-то ускорить эту операцию? Большое спасибо!
Код
Private Sub
Дата1()
Dim sFileName As String
sFileName1 = Workbooks("Старт.xlsm").Sheets("Обновка").Range("B1")
Workbooks("Старт.xlsm").Sheets("Обновка").Range("C1") = FileDateTime(sFileName1)
sFileName2 = Workbooks("Старт.xlsm").Sheets("Обновка").Range("B2")
Workbooks("Старт.xlsm").Sheets("Обновка").Range("C2") = FileDateTime(sFileName2)
sFileName3 = Workbooks("Старт.xlsm").Sheets("Обновка").Range("B3")
Workbooks("Старт.xlsm").Sheets("Обновка").Range("C3") = FileDateTime(sFileName3)
Дата2
End Sub
Private Sub
Дата2()
Dim sFileName As String
sFileName1 = Workbooks("Старт.xlsm").Sheets("Обновка").Range("D1")
Workbooks("Старт.xlsm").Sheets("Обновка").Range("E1") = FileDateTime(sFileName1)
sFileName2 = Workbooks("Старт.xlsm").Sheets("Обновка").Range("D2")
Workbooks("Старт.xlsm").Sheets("Обновка").Range("E2") = FileDateTime(sFileName2)
sFileName3 = Workbooks("Старт.xlsm").Sheets("Обновка").Range("D3")
Workbooks("Старт.xlsm").Sheets("Обновка").Range("E3") = FileDateTime(sFileName3)
Файл1
End Sub
Private Sub
Файл1()
If Workbooks("Старт.xlsm").Sheets("Обновка").Range("F1") = True Then
Workbooks.Open Filename:=Workbooks("Старт.xlsm").Sheets("Обновка").Range("D1")
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs
Filename:=Workbooks("Старт.xlsm").Sheets("Обновка").Range("B1") & Workbooks("Старт.xlsm").Sheets("Обновка").Range("I1").Value & Workbooks("Старт.xlsm").Sheets("Обновка").Range("J1")
Application.DisplayAlerts = True
ActiveWindow.Close False
Файл2
Else
Файл2
End If
End Sub
Private Sub
Файл2()
If Workbooks("Старт.xlsm").Sheets("Обновка").Range("F2") = True Then
Workbooks.Open Filename:=Workbooks("Старт.xlsm").Sheets("Обновка").Range("D2")
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs
Filename:=Workbooks("Старт.xlsm").Sheets("Обновка").Range("B2") & Workbooks("Старт.xlsm").Sheets("Обновка").Range("I2").Value & Workbooks("Старт.xlsm").Sheets("Обновка").Range("J2")
Application.DisplayAlerts = True
ActiveWindow.Close False
Файл3
Else
Файл3
End If
End Sub
Private Sub
Файл3()
If Workbooks("Старт.xlsm").Sheets("Обновка").Range("F3") = True Then
Workbooks.Open Filename:=Workbooks("Старт.xlsm").Sheets("Обновка").Range("D3")
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs
Filename:=Workbooks("Старт.xlsm").Sheets("Обновка").Range("B3") & Workbooks("Старт.xlsm").Sheets("Обновка").Range("I3").Value & Workbooks("Старт.xlsm").Sheets("Обновка").Range("J3")
Application.DisplayAlerts = True
ActiveWindow.Close False
Файл4
Else
Файл4
End If
End Sub
Platon, исправьте Ваш код, невозможно читать. По существу: вам обязательно необходимо открывать книгу, считывать данные с ячейки, если это больше того, то перезаписать того на это? Можно использовать объект FileSystemObject, который считает с файла дату его последнего изменения. Я что-то примерное делал здесь.