Yarek86 (Все сообщения пользователя)

Макрос копирования значений - медленно работает, Нужна оптимизация

Пользователь

Сообщений: 14 Регистрация: 24.03.2025

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. Их множество, выбрать сложно, так чтобы еще доступным языком написано было.

Перейти

Макрос копирования значений - медленно работает, Нужна оптимизация

Yarek86

Пользователь

Сообщений: 14 Регистрация: 24.03.2025

27.03.2025 17:00:20

МатросНаЗебре, я пытаюсь разобраться как внедрить код #12. Финальный код который получился #14, но у меня не введена переменная arr2 и я не понимаю как это сделать. Не могу разобраться с этой строкой arr2(1, (j - 1) * 5 + j1) = arr(j, j1)

Перейти

Макрос копирования значений - медленно работает, Нужна оптимизация

Yarek86

Пользователь

Сообщений: 14 Регистрация: 24.03.2025

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

Перейти

Формула для распределения сотрудников по категориям на основе процентов исполнения, Формула для распределения сотрудников по категориям на основе процентов исполнения

Yarek86 Пользователь Сообщений: 14 Регистрация: 24.03.2025	# 27.03.2025 14:24:56 Павел \Ʌ/, Я там уже был За замечание спасибо, сразу не смекнул
	Перейти

Yarek86 Пользователь Сообщений: 14 Регистрация: 24.03.2025	# 27.03.2025 09:38:35 Павел \Ʌ/, при использовании формулы в #2 для пустых значений в столбце "для Кат" присваивается высшая категория
	Перейти

Yarek86

Пользователь

Сообщений: 14 Регистрация: 24.03.2025

26.03.2025 15:42:34

Павел \Ʌ/, нужен. Может так

Код
=ЕСЛИОШИБКА(ВПР(ПРОЦЕНТРАНГ(ЕСЛИ(C$3:C$56>0;C$3:C$56;"");C3);{0;"Д":0,1;"Г":0,2;"В":0,8;"Б":0,9;"А"};2);"")

Перейти

Макрос копирования значений - медленно работает, Нужна оптимизация

Yarek86 Пользователь Сообщений: 14 Регистрация: 24.03.2025	# 26.03.2025 14:20:30 БМВ, i это значения на основании которого рассчитывается модель по заданным сценариям. Макрос подставляет эти значения и собирает сводный файл с результатами по сценариям.
	Перейти

Yarek86

Пользователь

Сообщений: 14 Регистрация: 24.03.2025

26.03.2025 12:53:03

Павел \Ʌ/, решение классное, но мне кажется по условию задачи "ЕСЛИ" применять вообще не стоит, т.к. рейтинг в определении категории не участвует, а сотрудникам без рейтинга присваивается низшая категория и коэф. 0,5

Перейти

Yarek86 Пользователь Сообщений: 14 Регистрация: 24.03.2025	# 26.03.2025 12:24:12 Павел \Ʌ/, для чего функция ЕСЛИ при указании массива в ПРОЦЕНТРАНГ? при такой формуле присваивается категория А и высший коэф. сотрудникам с "0" показателем
	Перейти

Макрос копирования значений - медленно работает, Нужна оптимизация

Yarek86

Пользователь

Сообщений: 14 Регистрация: 24.03.2025

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

Выдает ошибку.

Перейти

Макрос копирования значений - медленно работает, Нужна оптимизация

Yarek86 Пользователь Сообщений: 14 Регистрация: 24.03.2025	# 25.03.2025 15:12:30 MikeVol, попробую, но Ваш код мне не особо понятен, я новичок
	Перейти

Макрос копирования значений - медленно работает, Нужна оптимизация

Yarek86 Пользователь Сообщений: 14 Регистрация: 24.03.2025	# 25.03.2025 15:09:25 Большое спасибо! Сработало. Не совсем понятно как в массив собрать. Необходимо ввести 2 переменных А и В. Dim A As integer Dim B As integer A = диапазон (откуда) В = диапазон (куда) А = В
	Перейти

Макрос копирования значений - медленно работает, Нужна оптимизация

Yarek86

Пользователь

Сообщений: 14 Регистрация: 24.03.2025

25.03.2025 14:17:47

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

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

Перейти

Макрос копирования значений - медленно работает, Нужна оптимизация

Yarek86

Пользователь

Сообщений: 14 Регистрация: 24.03.2025

24.03.2025 12:08:36

Добрый день.
Макрос очень долго выполняется, подскажите может можно как-нибудь его оптимизировать.

Скрытый текст

Код

Sub Заполнение()

Dim i As Integer
Dim t As Integer

i = 4
t = 1

Do While Cells(i, t) <> Empty
Worksheets("Свод результатов 2 (доп) (2)").Cells(1, 1) = Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t)

Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 1) = Worksheets("Свод сценариев").Cells(7, 31) &#39;1
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 2) = Worksheets("Свод сценариев").Cells(7, 32) &#39;1
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 3) = Worksheets("Свод сценариев").Cells(7, 33) &#39;1
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 4) = Worksheets("Свод сценариев").Cells(7, 34) &#39;1
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 5) = Worksheets("Свод сценариев").Cells(7, 35) &#39;1


Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 6) = Worksheets("Свод сценариев").Cells(8, 31) &#39;2
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 7) = Worksheets("Свод сценариев").Cells(8, 32) &#39;2
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 8) = Worksheets("Свод сценариев").Cells(8, 33) &#39;2
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 9) = Worksheets("Свод сценариев").Cells(8, 34) &#39;2
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 10) = Worksheets("Свод сценариев").Cells(8, 35) &#39;2


Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 11) = Worksheets("Свод сценариев").Cells(9, 31) &#39;3
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 12) = Worksheets("Свод сценариев").Cells(9, 32) &#39;3
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 13) = Worksheets("Свод сценариев").Cells(9, 33) &#39;3
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 14) = Worksheets("Свод сценариев").Cells(9, 34) &#39;3
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 15) = Worksheets("Свод сценариев").Cells(9, 35) &#39;3


Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 16) = Worksheets("Свод сценариев").Cells(10, 31) &#39;4
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 17) = Worksheets("Свод сценариев").Cells(10, 32) &#39;4
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 18) = Worksheets("Свод сценариев").Cells(10, 33) &#39;4
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 19) = Worksheets("Свод сценариев").Cells(10, 34) &#39;4
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 20) = Worksheets("Свод сценариев").Cells(10, 35) &#39;4


Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 21) = Worksheets("Свод сценариев").Cells(11, 31) &#39;5
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 22) = Worksheets("Свод сценариев").Cells(11, 32) &#39;5
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 23) = Worksheets("Свод сценариев").Cells(11, 33) &#39;5
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 24) = Worksheets("Свод сценариев").Cells(11, 34) &#39;5
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 25) = Worksheets("Свод сценариев").Cells(11, 35) &#39;5


Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 26) = Worksheets("Свод сценариев").Cells(12, 31) &#39;6
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 27) = Worksheets("Свод сценариев").Cells(12, 32) &#39;6
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 28) = Worksheets("Свод сценариев").Cells(12, 33) &#39;6
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 29) = Worksheets("Свод сценариев").Cells(12, 34) &#39;6
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 30) = Worksheets("Свод сценариев").Cells(12, 35) &#39;6


Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 31) = Worksheets("Свод сценариев").Cells(13, 31) &#39;7
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 32) = Worksheets("Свод сценариев").Cells(13, 32) &#39;7
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 33) = Worksheets("Свод сценариев").Cells(13, 33) &#39;7
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 34) = Worksheets("Свод сценариев").Cells(13, 34) &#39;7
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 35) = Worksheets("Свод сценариев").Cells(13, 35) &#39;7


Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 36) = Worksheets("Свод сценариев").Cells(14, 31) &#39;8
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 37) = Worksheets("Свод сценариев").Cells(14, 32) &#39;8
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 38) = Worksheets("Свод сценариев").Cells(14, 33) &#39;8
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 39) = Worksheets("Свод сценариев").Cells(14, 34) &#39;8
Worksheets("Свод результатов 2 (доп) (2)").Cells(i, t + 40) = Worksheets("Свод сценариев").Cells(14, 35) &#39;8


i = i + 1
Loop

End Sub

Перейти