Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Ускорение макроса добавления строк
 
#1
13.01.2018 15:31:59
Добрый день.
Помогите пожалуйста решить вопрос с ускорением макроса.
Есть макрос, который проверяет заполненные строки и после каждой заполненной добавляет пустую строку. Но при большом кол-ве строк файл просто зависает и можно идти смотреть кино. Как можно ускорить этот процесс?
Вот код этого макроса
Код
'Добавляем
Sub InsertRows()
   Dim i As Long: i = 1
   Do While i < 20000 '20000 - количество проверяемых строк
      If Not IsEmpty(Cells(i, 1)) Then Cells(i + 1, 1).EntireRow.Insert
      i = i + 2
   Loop
End Sub
Изменено: anddrei55 - 13.01.2018 15:32:49
 
 
 
#2
13.01.2018 15:38:33
F1 и Гугл в помощь
Код
application.screenupdating=0
И логика странная - если текущая строка пустая, д.б. i=i+1, а не i+2.
Изменено: Апострофф - 13.01.2018 15:42:40
 
 
 
#3
13.01.2018 15:42:44
Апострофф, Гугл это хорошо, но я надеюсь мне профессионалы тут помогут, а не школьники с гугла.
 
 
 
#4
13.01.2018 15:45:14
Школьник, который с гугла всему научмлся отвечает

1 если вы Do While i < 20000 '20000 - количество проверяемых строк и i = i + 2, то вы проверяете ровно половину исходных строк. Если так и надо, то ок, если нет, то лучше начинать от последней к первой, тогда на сдвиг можно внимания не обращать.
2. а ускорить простыми отключениями
Код
With Application
KeepCalc = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

'Your code there

With Application
.Calculation = KeepCalc
.ScreenUpdating = True
.EnableEvents = True
End With
Изменено: БМВ - 13.01.2018 15:47:14
По вопросам из тем форума, личку не читаю.
 
 
 
#5
13.01.2018 15:49:33
Цитата
anddrei55 написал:
...школьники с гугла...
А с чего это Вы взяли, что там одни школьники?
 
 
 
#6
13.01.2018 15:52:44
БМВ, Спасибо за помощь. Пропишите пожалуйста полностью код как он должен быть и чтоб лучше работал "то лучше начинать от последней к первой"
 
 
 
#7
13.01.2018 15:54:05
offtop. Юрий М, Я продолжаю учится -  значит я  школьник, ведь это не то, что я хожу в школу :-)
По вопросам из тем форума, личку не читаю.
 
 
 
#8
13.01.2018 16:04:43
Если нужно радикально ускорить, то вариант: забрать исходный диапазон в массив, создать второй массив, который будет в два раза больше, затем цикл по первому с проверкой и перекладывать в нужные строки второго массива. Затем по количеству заполненных строк выгрузить второй массив на лист. Будет очень быстро.
 
 
 
#9
13.01.2018 16:04:44
Юрий М, БМВ,  извините если я кого-то обидел, не для этого я создал тему. В интернете много непонятного и неверного, а тут практически онлайн общение да и люди знающие.
Изменено: anddrei55 - 13.01.2018 16:05:00
 
 
 
#10
13.01.2018 16:08:52
Прикрепляю файл примера
 
 
 
#11
13.01.2018 16:14:03
Цитата
Юрий М написал:
забрать исходный диапазон в массив
этот вариант может оказаться спорным, если данных много и массив большой. Время загрузки и выгрузки может оказаться существенным. + там всякие форматы надо учесть .... короче вариант однозначно рабочий, но применять надо , как и все прочие, осмысленно.

anddrei55,  Вопрос не в том, когл вы считаете школьником, а в том что
https://yandex.ru/search/?text=%D0%A3%D1%81%D0%BA%D0%BE%D1%80%D0%B8%D1%82%D1%8C%20%D1%­80%D0%B0%D0%B1...
обратите внимание на первую ссылку и куда она ведет.
По вопросам из тем форума, личку не читаю.
 
 
 
#12
13.01.2018 16:23:03
БМВ, Спасибо.
 
 
 
#13
13.01.2018 16:26:00
БМВ, я же про сам принцип (вариант) ускорения )
anddrei55, Вашего примера не было - набросал вариант для диапазона из трёх столбцов. Данные начинаются со второй строки. Доработать под большее колчество столбов проблем не составит.
Код
Sub Macro1()
Dim LastRow As Long, i As Long, x As Long, Arr()
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Arr = Range(Cells(2, 1), Cells(LastRow, 3)).Value
    x = 1
    ReDim arr2(1 To UBound(Arr) * 2, 1 To 3)
    For i = 1 To UBound(Arr)
        arr2(x, 1) = Arr(i, 1)
        arr2(x, 2) = Arr(i, 2)
        arr2(x, 3) = Arr(i, 3)
        If Arr(i, 1) <> "" Then
            x = x + 2
        Else
            x = x + 1
        End If
    Next
    Range("A2").Resize(x, 3).Value = arr2
End Sub
 
 
 
#14
13.01.2018 17:14:14
Цитата
Юрий М написал:
БМВ, я же про сам принцип (вариант) ускорения )
То что Вы Умник в самом положительном смысле - я даже под сомнение ставить не стану. Просто отметил что способ может быть не так хорош, как ожидается, при определенных условиях.  
По вопросам из тем форума, личку не читаю.
 
 
 
Страницы: 1
Наверх