Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Копирование диапазонов чисел в цикле (оптимизация макроса) - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование диапазонов чисел в цикле (оптимизация макроса) (Макросы/Sub)
Копирование диапазонов чисел в цикле (оптимизация макроса)
djon2012 Дата: Понедельник, 30.01.2017, 09:08 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 106
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Здравствуйте!!! Огромная просьба к Вам форумчане, очень нужно оптимизировать небольшой макрос с целью более быстрого его выполнения. Я прикрепил 2 файла Книга 1(_1) и Книга 2 (_2) (оба имеют макрос). В файле Книга 1 (_1) имеется макрос который нужно оптимизировать. Действия макроса я не буду описывать так как он очень маленький и любой на форуме сможет запустив его или просто прочитав понять суть его действий. В файле Книга 2 (_2)лежит макрос написанный одним из форумчанов, за что ему большое спасибо. Это макрос делает вывод случайных чисел из диапазона (копирование) данных значительно быстрее. Возможно на форуме найдутся Человеки которые смогут мне помочь, применив алгоритм макроса из файла Книга 2 (_2)для оптимизации макроса файла Книга 1 (_1). Спасибо всем кто откликнулся !!!
К сообщению приложен файл: _1.xlsb (24.0 Kb) · _2.xlsb (77.3 Kb)


Сообщение отредактировал djon2012 - Понедельник, 30.01.2017, 09:10
 
Ответить
СообщениеЗдравствуйте!!! Огромная просьба к Вам форумчане, очень нужно оптимизировать небольшой макрос с целью более быстрого его выполнения. Я прикрепил 2 файла Книга 1(_1) и Книга 2 (_2) (оба имеют макрос). В файле Книга 1 (_1) имеется макрос который нужно оптимизировать. Действия макроса я не буду описывать так как он очень маленький и любой на форуме сможет запустив его или просто прочитав понять суть его действий. В файле Книга 2 (_2)лежит макрос написанный одним из форумчанов, за что ему большое спасибо. Это макрос делает вывод случайных чисел из диапазона (копирование) данных значительно быстрее. Возможно на форуме найдутся Человеки которые смогут мне помочь, применив алгоритм макроса из файла Книга 2 (_2)для оптимизации макроса файла Книга 1 (_1). Спасибо всем кто откликнулся !!!
Автор - djon2012
Дата добавления - 30.01.2017 в 09:08
Timber_Wolf Дата: Понедельник, 30.01.2017, 09:37 | Сообщение № 2
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 107
Репутация: 2 ±
Замечаний: 0% ±

Excel 2010
djon2012, Не совсем понятно что вы хотите... Но первое что приходит на ум
[vba]
Код
Application.ScreenUpdating = False
' Ваш макрос        
Application.ScreenUpdating = True
[/vba]
Ускорение уже в 3-4 раза
 
Ответить
Сообщениеdjon2012, Не совсем понятно что вы хотите... Но первое что приходит на ум
[vba]
Код
Application.ScreenUpdating = False
' Ваш макрос        
Application.ScreenUpdating = True
[/vba]
Ускорение уже в 3-4 раза
Автор - Timber_Wolf
Дата добавления - 30.01.2017 в 09:37
Timber_Wolf Дата: Понедельник, 30.01.2017, 09:44 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 107
Репутация: 2 ±
Замечаний: 0% ±

Excel 2010
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 и после каких то ваших действий все стираем. Тогда смысл вообще? Т.к. в макросе не видно нужны ли вам вообще эти данные? И вы работаете с листом, что сильно замедляет макрос. Попробуйте всю обработку производить в массивах...
 
Ответить
Сообщение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
Дата добавления - 30.01.2017 в 09:44
djon2012 Дата: Понедельник, 30.01.2017, 10:36 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 106
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Увеличение скорости обработки макроса посредством отключения обновления экрана это я знал, но все равно спасибо за подсказку. На счет работы макроса Вы все правильно поняли, за исключением "все стираем". Стираем только выделенный диапазон, после того как с ним будут произведены необходимые действия. Да все операции происходят с листом, я знаю что с массивами намного быстрее но незнаю как ими пользоваться. Спасибо!
 
Ответить
СообщениеУвеличение скорости обработки макроса посредством отключения обновления экрана это я знал, но все равно спасибо за подсказку. На счет работы макроса Вы все правильно поняли, за исключением "все стираем". Стираем только выделенный диапазон, после того как с ним будут произведены необходимые действия. Да все операции происходят с листом, я знаю что с массивами намного быстрее но незнаю как ими пользоваться. Спасибо!
Автор - djon2012
Дата добавления - 30.01.2017 в 10:36
K-SerJC Дата: Понедельник, 30.01.2017, 11:26 | Сообщение № 5
Группа: Проверенные
Ранг: Обитатель
Сообщений: 487
Репутация: 86 ±
Замечаний: 0% ±

Excel 2013
так?
[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
[/vba]
5,082

ваш код:
46,37

Благими намерениями выстелена дорога в АД.

Сообщение отредактировал K-SerJC - Понедельник, 30.01.2017, 11:39
 
Ответить
Сообщениетак?
[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
[/vba]
5,082

ваш код:
46,37
Автор - K-SerJC
Дата добавления - 30.01.2017 в 11:26
Timber_Wolf Дата: Понедельник, 30.01.2017, 12:06 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 107
Репутация: 2 ±
Замечаний: 0% ±

Excel 2010
K-SerJC, Это я уже предложил =))
djon2012, А вы попробуйте описать действия с данными... А то мы говорим абстрактно как то...
Такой же абстрактный ответ взять в массив будет так: [vba]
Код
arr=Range(Cells(b, 3), Cells(1001, 3))
[/vba] А дальше ваши действия...
 
Ответить
СообщениеK-SerJC, Это я уже предложил =))
djon2012, А вы попробуйте описать действия с данными... А то мы говорим абстрактно как то...
Такой же абстрактный ответ взять в массив будет так: [vba]
Код
arr=Range(Cells(b, 3), Cells(1001, 3))
[/vba] А дальше ваши действия...
Автор - Timber_Wolf
Дата добавления - 30.01.2017 в 12:06
K-SerJC Дата: Понедельник, 30.01.2017, 12:53 | Сообщение № 7
Группа: Проверенные
Ранг: Обитатель
Сообщений: 487
Репутация: 86 ±
Замечаний: 0% ±

Excel 2013
[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
[/vba]
1,19сек
Автор - K-SerJC
Дата добавления - 30.01.2017 в 12:53
djon2012 Дата: Понедельник, 30.01.2017, 14:00 | Сообщение № 8
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 106
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Спасибо, приду с работы попробую на компе вставив свои дополнительные данные.
 
Ответить
СообщениеСпасибо, приду с работы попробую на компе вставив свои дополнительные данные.
Автор - djon2012
Дата добавления - 30.01.2017 в 14:00
djon2012 Дата: Понедельник, 30.01.2017, 20:37 | Сообщение № 9
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 106
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
K-SerJC запустил ваш макрос и честно говоря просто офигел от скорости его выполнения. Макрос работает ну очень быстро и так как надо. Огромное Вам спасибо, честно даже не ожидал такой результат. hands hands hands :D :D :D


Сообщение отредактировал djon2012 - Понедельник, 30.01.2017, 20:38
 
Ответить
СообщениеK-SerJC запустил ваш макрос и честно говоря просто офигел от скорости его выполнения. Макрос работает ну очень быстро и так как надо. Огромное Вам спасибо, честно даже не ожидал такой результат. hands hands hands :D :D :D
Автор - djon2012
Дата добавления - 30.01.2017 в 20:37
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование диапазонов чисел в цикле (оптимизация макроса) (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!