Здравствуйте!!! Огромная просьба к Вам форумчане, очень нужно оптимизировать небольшой макрос с целью более быстрого его выполнения. Я прикрепил 2 файла Книга 1(_1) и Книга 2 (_2) (оба имеют макрос). В файле Книга 1 (_1) имеется макрос который нужно оптимизировать. Действия макроса я не буду описывать так как он очень маленький и любой на форуме сможет запустив его или просто прочитав понять суть его действий. В файле Книга 2 (_2)лежит макрос написанный одним из форумчанов, за что ему большое спасибо. Это макрос делает вывод случайных чисел из диапазона (копирование) данных значительно быстрее. Возможно на форуме найдутся Человеки которые смогут мне помочь, применив алгоритм макроса из файла Книга 2 (_2)для оптимизации макроса файла Книга 1 (_1). Спасибо всем кто откликнулся !!!
Здравствуйте!!! Огромная просьба к Вам форумчане, очень нужно оптимизировать небольшой макрос с целью более быстрого его выполнения. Я прикрепил 2 файла Книга 1(_1) и Книга 2 (_2) (оба имеют макрос). В файле Книга 1 (_1) имеется макрос который нужно оптимизировать. Действия макроса я не буду описывать так как он очень маленький и любой на форуме сможет запустив его или просто прочитав понять суть его действий. В файле Книга 2 (_2)лежит макрос написанный одним из форумчанов, за что ему большое спасибо. Это макрос делает вывод случайных чисел из диапазона (копирование) данных значительно быстрее. Возможно на форуме найдутся Человеки которые смогут мне помочь, применив алгоритм макроса из файла Книга 2 (_2)для оптимизации макроса файла Книга 1 (_1). Спасибо всем кто откликнулся !!!djon2012
К сообщению приложен файл:_1.xlsb
(24.0 Kb)
·
_2.xlsb
(77.3 Kb)
Сообщение отредактировал djon2012 - Понедельник, 30.01.2017, 09:10
Range("B2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Rem Здесь будет продолжение макроса Rem для последующей обработки даных Range("B2:B1001").Select Selection.ClearContents
[/vba] Что меня смущает кладем в столбец B и после каких то ваших действий все стираем. Тогда смысл вообще? Т.к. в макросе не видно нужны ли вам вообще эти данные? И вы работаете с листом, что сильно замедляет макрос. Попробуйте всю обработку производить в массивах...
djon2012, [vba]
Код
Range("B2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Rem Здесь будет продолжение макроса Rem для последующей обработки даных Range("B2:B1001").Select Selection.ClearContents
[/vba] Что меня смущает кладем в столбец B и после каких то ваших действий все стираем. Тогда смысл вообще? Т.к. в макросе не видно нужны ли вам вообще эти данные? И вы работаете с листом, что сильно замедляет макрос. Попробуйте всю обработку производить в массивах...Timber_Wolf
Увеличение скорости обработки макроса посредством отключения обновления экрана это я знал, но все равно спасибо за подсказку. На счет работы макроса Вы все правильно поняли, за исключением "все стираем". Стираем только выделенный диапазон, после того как с ним будут произведены необходимые действия. Да все операции происходят с листом, я знаю что с массивами намного быстрее но незнаю как ими пользоваться. Спасибо!
Увеличение скорости обработки макроса посредством отключения обновления экрана это я знал, но все равно спасибо за подсказку. На счет работы макроса Вы все правильно поняли, за исключением "все стираем". Стираем только выделенный диапазон, после того как с ним будут произведены необходимые действия. Да все операции происходят с листом, я знаю что с массивами намного быстрее но незнаю как ими пользоваться. Спасибо!djon2012
Sub Макрос1() Dim str As String Dim tm: tm = Timer Application.ScreenUpdating = False For b = 2 To 1000 Range(Cells(b, 3), Cells(1001, 3)).Copy 'Selection.Copy Range("B2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Rem Здесь будет продолжение макроса Rem для последующей обработки даных Range("B2:B1001").ClearContents Next b Application.ScreenUpdating = True MsgBox Timer - tm End Sub
[/vba] 5,082
ваш код: 46,37
так? [vba]
Код
Sub Макрос1() Dim str As String Dim tm: tm = Timer Application.ScreenUpdating = False For b = 2 To 1000 Range(Cells(b, 3), Cells(1001, 3)).Copy 'Selection.Copy Range("B2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Rem Здесь будет продолжение макроса Rem для последующей обработки даных Range("B2:B1001").ClearContents Next b Application.ScreenUpdating = True MsgBox Timer - tm End Sub
K-SerJC, Это я уже предложил =)) djon2012, А вы попробуйте описать действия с данными... А то мы говорим абстрактно как то... Такой же абстрактный ответ взять в массив будет так: [vba]
Код
arr=Range(Cells(b, 3), Cells(1001, 3))
[/vba] А дальше ваши действия...
K-SerJC, Это я уже предложил =)) djon2012, А вы попробуйте описать действия с данными... А то мы говорим абстрактно как то... Такой же абстрактный ответ взять в массив будет так: [vba]
Sub Макрос2() Dim temps, str, srtr, arr Dim tm: tm = Timer Application.ScreenUpdating = False For b = 2 To 1000 temps = 1002 - b str = "B2:B" & temps srtr = "C" & b & ":C1001" arr = Range(srtr).Value Range(str).Value = arr Rem Здесь будет продолжение макроса Rem для последующей обработки даных Range("B2:B1001").ClearContents Next b Application.ScreenUpdating = True MsgBox Timer - tm End Sub
[/vba] 1,19сек
[vba]
Код
Sub Макрос2() Dim temps, str, srtr, arr Dim tm: tm = Timer Application.ScreenUpdating = False For b = 2 To 1000 temps = 1002 - b str = "B2:B" & temps srtr = "C" & b & ":C1001" arr = Range(srtr).Value Range(str).Value = arr Rem Здесь будет продолжение макроса Rem для последующей обработки даных Range("B2:B1001").ClearContents Next b Application.ScreenUpdating = True MsgBox Timer - tm End Sub
K-SerJC запустил ваш макрос и честно говоря просто офигел от скорости его выполнения. Макрос работает ну очень быстро и так как надо. Огромное Вам спасибо, честно даже не ожидал такой результат. :D
K-SerJC запустил ваш макрос и честно говоря просто офигел от скорости его выполнения. Макрос работает ну очень быстро и так как надо. Огромное Вам спасибо, честно даже не ожидал такой результат. :D djon2012
Сообщение отредактировал djon2012 - Понедельник, 30.01.2017, 20:38