Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Создание файлов по шаблону с сохранением в новую папку, оптимизация кода для увеличение скорости
 
#1
23.04.2021 17:18:17
Здравствуйте! Пример не прикладываю - 5,3 Мб, много внутренних пересчетов. Файл на сервере.
Приложу код - рабочий, но неуклюжий. В цикле на 44 строки отработал за 17 минут - довольно долго. Компьютер очень неслабый.
Что поправить для увеличения скорости, помогите если есть время пожалуйста:
Код
Sub Пример()
Application.ScreenUpdating = False 'Отключаем обновление экрана
Application.EnableEvents = False 'Отключаем отслеживание событий
Application.DisplayAlerts = False 'Отключаем вывод сообщений во время макроса
Dim Papka_name1 As String, Name_file1 As String 'Объявляем переменные
Papka_name1 = ThisWorkbook.Path & "\" & "- Папка1" 'Путь к новой папке (добавить дату) 
If Dir(Papka_name1, 16) = "" Then MkDir Papka_name1 'Создаем папку
End If
Sheets("!ККК").Select 'Выбираем лист с данными
For i = 4 To 48 ' Запускаем цикл на 44 строки, начиная с четвертой строки
    If Cells(i, 21).Value = 2 Then 'Условие для дальнейшей обработки
Sheets("123").Cells(3, 6).Value = Sheets("!ККК").Cells(i, 22).Value 'Заполняем для i-того пересчета
Sheets("123").Cells(2, 6).Value = "Условие2"
Sheets("!ККК").Select ' Выбираем лист с данными
Name_file1 = Papka_name1 & "\" & Sheets("123").Cells(8, 6).Value & " - ККК " & ".xlsx" 'Имя файла
Sheets("!ККК").Cells(i, 14).Value = Sheets("12").Cells(2348, 12).Value 'Сбор инфы i-того пересчета
Sheets("!ККК").Cells(i, 28).Value = Sheets("12").Cells(2341, 11).Value
Sheets("!ККК").Cells(i, 29).Value = Sheets("12").Cells(2343, 12).Value
Sheets("!ККК").Cells(i, 30).Value = Sheets("12").Cells(2344, 12).Value
Sheets("!ККК").Cells(i, 31).Value = Sheets("12").Cells(2345, 12).Value
Sheets("!ККК").Cells(i, 32).Value = Sheets("12").Cells(2346, 12).Value
Sheets("!ККК").Cells(i, 33).Value = Sheets("12").Cells(2347, 12).Value
Sheets("!ККК").Cells(i, 34).Value = Sheets("12").Cells(2348, 12).Value
Sheets("!ККК").Cells(i, 27).Value = Sheets("12").Cells(2346, 14).Value
Sheets(Array("12", "123", "4", "5", "6", "7")).Copy 'Копирование выбранных листов в новую книгу
ActiveWorkbook.PrecisionAsDisplayed = True 'Задаем указанную точность
Sheets("12").Select 'Выбираем лист 12
Sheets("12").AutoFilter.Range.AutoFilter Field:=1, Criteria1:="Да" 'Фильтр первого поля по критерию
ActiveWorkbook.BreakLink Name:= "X:\- 2020\4\- Т\- И\2.xlsm", Type:=xlExcelLinks 'Разрыв внешних связей    
ActiveWorkbook.BreakLink Name:= "X:\С.xlsm", Type:=xlExcelLinks '(как разорвать все связи без пути?)
ActiveWorkbook.SaveAs Filename:= Name_file1, FileFormat:=51 'Сохраняем файл
ActiveWorkbook.Close 'Закрываем книгу
Workbooks("2.xlsm").Activate 'Активируем файл с макросом
Sheets("!ККК").Select 'Выбираем лист с данными
    End If
Next i
Exit Sub
    Application.ScreenUpdating = True 'Отключаем обновление экрана
    Application.EnableEvents = True 'Отключаем отслеживание событий
    Application.DisplayAlerts = True 'Отключаем вывод сообщений во время макроса
End Sub
Изменено: Тимофеев - 23.04.2021 21:51:33
 
 
 
#2
23.04.2021 17:41:04
Для того, чтобы продать что-то ненужное, надо сначала его купить. А для того, чтобы в конце макроса включать автопересчет, его, обычно, в начале отключают.
 
 
 
#3
23.04.2021 17:42:37
Эта строка лишняя, отключать пересчет не нужно в данном макросе - влияет на скорость?
Изменено: Тимофеев - 23.04.2021 20:20:16
 
 
 
#4
23.04.2021 17:47:54
RAN,
в комментарии написано отключаем - значит отключаем
(пофиг, что в коде включаем, а пофиг потому, что Exit Sub не даст это выполнить НИКОГДА, круг замкнулся)

Тимофеев,
зачем вы файл сохраняете 44 раза, так задумано или это ошибка?
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#5
23.04.2021 17:49:39
Calc убрал из 1 сообщения.
Сохраняю после разрыва внешних связей. Строку повторного сохранения убрал - изменил в 1 сообщении.
Разорвать все существующие связи можно без путей к файлам?
.Select может лишние есть?
Sheets("123").Cells(8, 6).Value в имени файла в ячейке 1.1 - файл получается 1,1.
Как блок:
Код
Sheets("!ККК").Cells(i, 29).Value = Sheets("12").Cells(2343, 12).Value
Sheets("!ККК").Cells(i, 30).Value = Sheets("12").Cells(2344, 12).Value
Sheets("!ККК").Cells(i, 31).Value = Sheets("12").Cells(2345, 12).Value
Sheets("!ККК").Cells(i, 32).Value = Sheets("12").Cells(2346, 12).Value
Sheets("!ККК").Cells(i, 33).Value = Sheets("12").Cells(2347, 12).Value
Sheets("!ККК").Cells(i, 34).Value = Sheets("12").Cells(2348, 12).Value
записать одной строкой - взять в массив значения и транспонированные записать на другом листе
Изменено: Тимофеев - 23.04.2021 20:15:57
 
 
 
#6
23.04.2021 21:10:32
Если вручную файл открыть манипуляции ввода цифр произвести, отфильтровать, выбрать нужные листы, скопировать в новую книгу, разорвать все связи, в свойствах указанную точность поставить и сохранить с именем (ввод с клавиатуры), то быстрее получается - поэтому и вопрос (видимо режим просто чтения с форума и под свой вариант допиливание даётся трудно, что-то делаю явно не так). Думаю есть тут очень много людей, читающих код как газету и видящих откровенные ляпы - очень жду их совет
Изменено: Тимофеев - 24.04.2021 08:16:18
 
 
 
#7
24.04.2021 21:30:46
Попробовал сегодня на 328 строк ждал почти 3 часа выполнения
Изменено: Тимофеев - 24.04.2021 21:32:04
 
 
 
#8
24.04.2021 21:32:47
Тимофеев, вы бы уже приложили файл-прмиер (не нужен никому ваш рабочий файл достаточно фрагмента) и уже думаю получили бы решение
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#9
24.04.2021 21:36:42
Сегодня не смогу уже с 7 утра его кручу верчу, уже ни глаза ни голова не готова делать пример - завтра придумаю что-нибудь но пересчетов формул очень много - это не воссоздам все что в смете ру и ещё куча дополнительных расчетов и условий
Изменено: Тимофеев - 24.04.2021 21:38:05
 
 
 
#10
24.04.2021 21:40:24
Тимофеев, о по сметам тут кто-то был очень умный) может увидит откликнется.
а вообще исходный файл и желаемый результат возможно ускорит получение ответа
Изменено: Mershik - 24.04.2021 21:41:52
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#11
24.04.2021 21:43:34
Комп сильный у меня в ручную манипуляцию делаю быстрее - это значит лишние селекты делаю ненужные и доп пересчеты как следствие, а может и обновление связей- если это так то их не нужно обновлять во время выполнения. Также в момент работы ещё несколько файлов открыты потяжелее этого в разы и возможно там тоже пересчеты идут
Изменено: Тимофеев - 24.04.2021 22:52:39
 
 
 
#12
25.04.2021 02:00:52
1. "Workbooks("2.xlsm")" - это  в вашем коде, то же самое, что "ThisWorkbook" ?
2. Инструкция "For i = 4 To 48 'Запускаем цикл на 44 строки, начиная с четвертой строки"
Для этой инструкции это 45 строк, не 44 строки.
3. "как разорвать все связи без пути?"
Это зависит от того, какие это ссылки, связи - например:
Код
Dim arrlnks, i As Long, wB As Workbook
Set wB = ActiveWorkbook
arrlnks = wB.LinkSources(Type:=xlLinkTypeExcelLinks)

If Not IsEmpty(arrlnks) Then
    For i = 1 To UBound(arrlnks)
        wB.BreakLink Name:=arrlnks(i), Type:=xlLinkTypeExcelLinks
    Next
End If

ActiveSheet.Hyperlinks.Delete
Cells.Validation.Delete
Cells.FormatConditions.Delete

4. Вместо

Код
Sheets("!ККК").Cells(i, 14).Value = Sheets("12").Cells(2348, 12).Value
Sheets("!ККК").Cells(i, 27).Value = Sheets("12").Cells(2346, 14).Value
Sheets("!ККК").Cells(i, 28).Value = Sheets("12").Cells(2341, 11).Value
Sheets("!ККК").Cells(i, 29).Value = Sheets("12").Cells(2343, 12).Value
Sheets("!ККК").Cells(i, 30).Value = Sheets("12").Cells(2344, 12).Value
Sheets("!ККК").Cells(i, 31).Value = Sheets("12").Cells(2345, 12).Value
Sheets("!ККК").Cells(i, 32).Value = Sheets("12").Cells(2346, 12).Value
Sheets("!ККК").Cells(i, 33).Value = Sheets("12").Cells(2347, 12).Value
Sheets("!ККК").Cells(i, 34).Value = Sheets("12").Cells(2348, 12).Value
лучше так

Код
Set shККК = Sheets("!ККК")
Set sh12 = Sheets("12")

k = 0
rc = Array(2348, 12, 2346, 14, 2341, 11, 2343, 12, 2344, 12, 2345, 12, 2346, 12, 2347, 12, 2348, 12)

shККК.Cells(i, 14).Value = sh12.Cells(rc(0), rc(1)).Value

For j = 27 To 34
    k = k + 2
    shККК.Cells(i, j).Value = sh12.Cells(rc(k), rc(k + 1)).Value
Next
5. ".Activate/.Select" (Workbooks("2.xlsm") / Sheets("!ККК"))
".Activate / .Select" необходимо удалить из этого кода.
6. Какие именно действия, операции с файлом (ами) вы хотите выполнить ?
 
 
 
#13
25.04.2021 07:33:54
8 строка кода в сообщении 1 End If не нужна
 
 
 
Страницы: 1
Наверх