Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Макрос копирования значений - медленно работает, Нужна оптимизация
 
#1
24.03.2025 12:08:36
Добрый день.
Макрос очень долго выполняется, подскажите может можно как-нибудь его оптимизировать.

Скрытый текст
 
 
 
#2
24.03.2025 13:11:58
Код
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 1). = Worksheets("Свод сценариев").Cells(7, 31) 
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 2) = Worksheets("Свод сценариев").Cells(7, 32)
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 3) = Worksheets("Свод сценариев").Cells(7, 33)
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 4) = Worksheets("Свод сценариев").Cells(7, 34)
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 5) = Worksheets("Свод сценариев").Cells(7, 35)


Меняется на
Код
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 1).Resize(,5) = Worksheets("Свод сценариев").Cells(7, 31).Resize(,5)

что должно уже чуть ускорить
но в идеале собрать все
Код
A=Worksheets("Свод сценариев").range(Worksheets("Свод сценариев").range.Cells(7, 31).resize(8,5))
в массив A(8,5) потом в цикле получить массив B (1,40) размещая все по "полочкам" , и выгрузить строку
Код
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 1).Resize(,40)=B


При желании можно  и B  сделать расзмером по итоговому количеству строк туда все напихать и разом выгрузить.
По вопросам из тем форума, личку не читаю.
 
 
 
#3
25.03.2025 14:17:47
Код
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 1).Resize(,5) = Worksheets("Свод сценариев").Cells(7, 31).Resize(,5)
Копирует пустые значения, убрал resize во второй части получилось дублирование значения на диапазон. если наоборот убрать из первой, то выдает ошибку. Не пойму что сделать со второй частью чтобы заработало.
 
 
 
#4
25.03.2025 14:53:27
Добавьте и там и там   .Value
Код
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 1).Resize(,5).Value = Worksheets("Свод сценариев").Cells(7, 31).Resize(,5).Value


и еще момент, а на получаемы лист никакие формулы не натравлены? Если да то автоперсчет на время работы отключить нужно.
По вопросам из тем форума, личку не читаю.
 
 
 
#5
25.03.2025 14:59:55
Yarek86, А так:
Код
    Dim j           As Integer
    Dim arr         As Variant

    Dim ws1         As Worksheet
    Set ws1 = Worksheets("Свод сценариев")

    Dim ws2         As Worksheet
    Set ws2 = Worksheets("Свод результатов 2 (доп) (2)")

    Dim i           As Integer
    i = 4

    Do While ws2.Cells(i, 1) <> Empty
        arr = ws1.Range("AE7:AI14").Value    ' Считываем данные из диапазона AE7:AI14 (31-35 столбцы) в массив с листа "Свод сценариев"
        ws2.Cells(i, 1).Value = ws2.Cells(i, 1).Value

        For j = 1 To 8
            ws2.Cells(i, 2 + (j - 1) * 5).Resize(1, 5).Value = Application.Index(arr, j, 0)
        Next j

        i = i + 1
    Loop
?
Изменено: MikeVol - 25.03.2025 15:51:21 (Проверив предыдущий код на данных обнаружил ошибки, прошу считать не правильным решением предыдущий код)
 
 
 
#6
25.03.2025 15:09:25
Большое спасибо! Сработало.

Не совсем понятно как в массив собрать. Необходимо ввести 2 переменных А и В.
Dim A As integer
Dim B As integer

A = диапазон (откуда)
В = диапазон (куда)

А = В
 
 
 
#7
25.03.2025 15:12:30
MikeVol, попробую, но Ваш код мне не особо понятен, я новичок
 
 
 
#8
25.03.2025 16:01:35
Yarek86, Пршу прощения. В предыдущем своём посте обновил код, причину указал в описание под кодом. В новом коде я применил также массив чтобы не копировать каждую ячейку по очереди, данные считываются сразу в массив (arr) из диапазона "AE7:AI14". .Resize - используется для того, чтобы записать сразу 5 значений в соответствующие ячейки. Application.Index - используется для извлечения нужных строк из массива arr и записи их в соответствующие ячейки. Ну и куда без цикла For j, сокращяем строки в коде. Иначе код без него выглядил бы так:
Код
        ws2.Cells(i, 2).Resize(1, 5).Value = Application.Index(arr, 1, 0)
        ws2.Cells(i, 7).Resize(1, 5).Value = Application.Index(arr, 2, 0)
        ws2.Cells(i, 12).Resize(1, 5).Value = Application.Index(arr, 3, 0)
        ws2.Cells(i, 17).Resize(1, 5).Value = Application.Index(arr, 4, 0)
        ws2.Cells(i, 22).Resize(1, 5).Value = Application.Index(arr, 5, 0)
        ws2.Cells(i, 27).Resize(1, 5).Value = Application.Index(arr, 6, 0)
        ws2.Cells(i, 32).Resize(1, 5).Value = Application.Index(arr, 7, 0)
        ws2.Cells(i, 37).Resize(1, 5).Value = Application.Index(arr, 8, 0)
Тоже много строк. Описал как смог, не судите строго.  :D
 
 
 
#9
26.03.2025 09:16:50
Цитата
Yarek86 написал:
Не совсем понятно как в массив собрать. Необходимо ввести 2 переменных А и В.
нет
один будет автоматом сделан при присвоении
второй нужно определить с размерностью, ведь определить общее количество строк сразу не сложно (1x40) , потом в цикле уже переставлять
типа А массив будет (8x5)
1,2,3,4,5
6,7,8,9,1
0,1,0,1,0
....

B после преобразования ( но это массив  двумерный 1x40)
1,2,3,4,5,6,7,8,9,1,0,1,0,1,0 ....

и вот его можно сразу присвоить одной строке  i от t+1 до t+40yj
По вопросам из тем форума, личку не читаю.
 
 
 
#10
26.03.2025 11:13:24
MikeVol, Спасибо! Работает, стало еще быстрее :)

Внес небольшое исправление, код выглядит так:
Код
Sub Тест1()

    Dim j As Integer
    Dim arr As Variant

    Dim ws1 As Worksheet
    Set ws1 = Worksheets("Свод сценариев")

    Dim ws2 As Worksheet
        Set ws2 = Worksheets("ТЕСТ1")

    Dim i As Integer
        i = 4
        
        
    Do While Cells(i, 1) <> Empty
        ws2.Cells(1, 1) = ws2.Cells(i, 1) 'Добавил
        arr = ws1.Range("AD7:AH14").Value
        ws2.Cells(i, 1).Value = ws2.Cells(i, 1).Value
    
        For j = 1 To 8
            ws2.Cells(i, 2 + (j - 1) * 5).Resize(1, 5).Value = Application.Index(arr, j, 0)
        Next j
    

        i = i + 1
    Loop

End Sub

А как записать

Код
arr = ws1.Range("AD7:AH14").Value

В виде

Код
arr = ws1.Range(cells(7, 30), Cells(14, 34)).Value
Выдает ошибку.
 
 
 
#11
26.03.2025 12:40:53
Yarek86,
Код
arr = ws1.Range(ws1.Cells(7, 31), ws1.Cells(14, 35)).Value
 вы изминили диапазон
Код
arr = ws1.Range(ws1.Cells(7, 30), ws1.Cells(14, 34)).Value
Изменено: MikeVol - 26.03.2025 12:44:23
 
 
 
#12
26.03.2025 13:57:23
Давно напрашивается вопрос, в строки i всегда копируется то что в одном диапазоне. Каков смысл?

ну и
Код
        For j = 1 To 8
            For j1 = 1 To 5
             arr2(1, (j - 1) * 5 + j1) = arr(j, j1)
            Next j1
        Next j
        ws1.Cells(i, t + 1).Resize(, 40) = arr2
По вопросам из тем форума, личку не читаю.
 
 
 
#13
26.03.2025 14:20:30
БМВ, i это значения на основании которого рассчитывается модель по заданным сценариям. Макрос подставляет эти значения и собирает сводный файл с результатами по сценариям.
 
 
 
#14
27.03.2025 15:03:12
БМВ,  подскажите, пожалуйста, преобразовал код по Вашей методе, но просто заменить не получается. Полагаю нужно ввести переменную arr2, но никак не пойму как. По примеру arr (Dim arr2 as Variant), далее по примеру присваивается диапазон, но  "arr2(1, (j - 1) * 5 + j1)" это ячейка, дальше у меня затык.

Код
Sub Тест1()

    Dim j As Integer
    Dim arr As Variant

    Dim ws1 As Worksheet
    Set ws1 = Worksheets("Свод сценариев")

    Dim ws2 As Worksheet
        Set ws2 = Worksheets("ТЕСТ1")

    Dim i As Integer
        i = 4
        
        
    Do While Cells(i, 1) <> Empty
        ws2.Cells(1, 1) = ws2.Cells(i, 1) 'Добавил

        arr = ws1.Range(ws1.Cells(7, 30), ws1.Cells(14, 34)).Value
        ws2.Cells(i, 1).Value = ws2.Cells(i, 1).Value 'Предполагаю это теперь лишнее
    
        For j = 1 To 8
            For j1 = 1 To 5
             arr2(1, (j - 1) * 5 + j1) = arr(j, j1)
            Next j1
        Next j
        ws1.Cells(i, t + 1).Resize(, 40) = arr2
    

        i = i + 1
    Loop

End Sub
Изменено: Yarek86 - 27.03.2025 16:56:15
 
 
 
#15
27.03.2025 15:10:06
Код
        x2 = 0
        For j = 1 To 8
            For j1 = 1 To 5
                x2 = x2 + 1
                arr2(1, x2) = arr(j, j1)
            Next j1
        Next j
Так?
 
 
 
#16
27.03.2025 17:00:20
МатросНаЗебре, я пытаюсь разобраться как внедрить код #12. Финальный код который получился #14, но у меня не введена переменная arr2 и я не понимаю как это сделать. Не могу разобраться с этой строкой arr2(1, (j - 1) * 5 + j1) = arr(j, j1)
 
 
 
#17
27.03.2025 17:01:59
Цитата
написал:
у меня не введена переменная arr2 и я не понимаю как это сделать.
Код
Redim arr2(1 to 1, 1 to 40)
 
 
 
#18
27.03.2025 19:34:00
Цитата
написал:
Redim arr2(1 to 1, 1 to 40)
ну в данном случае просто Dim arr2(1 to 1, 1 to 40)
а вот x2 = x2 + 1 - да, можно использовать, и допускаю что будет даже шустрее ибо операций меньше.

Но и тут нужно сравнивать скорость с Application.Index.

По любому лучше обновление экрана на момент выполнения процедуры притушить.
Изменено: БМВ - 27.03.2025 19:36:17
По вопросам из тем форума, личку не читаю.
 
 
 
#19
28.03.2025 14:33:27
Большое спасибо всем! Наше обсуждение меня натолкнуло на мысль расширить массив arr2 (записать туда необходимое кол-во строк) и еще добавил отключение обновления экрана, что оказалось еще быстрее.
Можно как-то прописать arr2("в зависимости от кол-ва значений в ws2(A:A)", 1 to 40)?
И можно ли разложить таблицу arr = ws1.Range("AD7:AH14").Value  в строку и записать в ws2.cells(i, 2).resize(1, 40)?
Посоветуйте, пожалуйста, учебник для начинающих по VBA. Их множество, выбрать сложно, так чтобы еще доступным языком написано было.
 
 
 
Страницы: 1
Читают тему
Наверх