Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Ускорить макрос пересохранения файлов
 
#1
12.09.2016 10:04:25
Два одинаковых файла лежат в разных папках. Макросы "Дата" определяют дату последнего изменения каждого из них. Если даты разные (значение ИСТИНА в столбце 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 - 12.09.2016 18:18:37
 
 
 
#2
12.09.2016 10:18:26
Platon, что Вы сделали с кодом? Невозможно прочесть... Я пас.
 
 
 
#3
12.09.2016 10:31:19
Цитата
Platon написал: как-то ускорить эту операцию
Заменить HDD на SSD.

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
 
 
#4
12.09.2016 10:44:36
Еще бы знать, что это такое...
 
 
 
#5
12.09.2016 10:52:15
Platon, воспользуйтесь поиском, будьте добры. Это, так сказать, аппаратная часть Вашего ПК.

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
 
 
#6
12.09.2016 11:29:46
Platon, исправьте Ваш код, невозможно читать.
По существу: вам обязательно необходимо открывать книгу, считывать данные с ячейки, если это больше того, то перезаписать того на это?
Можно использовать объект FileSystemObject, который считает с файла дату его последнего изменения.
Я что-то примерное делал здесь.  
 
 
 
#7
12.09.2016 18:20:16
Код исправил. Не открывать книгу даже лучше. Главное сократить код, чтобы макрос выполнялся быстрее.
 
 
 
#8
12.09.2016 18:22:58
Цитата
Platon написал: Код исправил
Исправьте свое первое сообщение, читать больно. Для чего Вы такой шрифт использовали? От этого помощь быстрее не придет, только отталкивает
Согласие есть продукт при полном непротивлении сторон
 
 
 
Страницы: 1
Наверх