Страницы: 1
RSS
Удалить строки по условию
 
Добрый день!
Написал небольшой макрос, необходимо из файла удалить строки по условию, но т.к. строк в файле ооочень много сижу уже пол часа жду когда закончится. как можно ускорить? или есть другие способы?
Код
Sub udalenie()
    ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Activate
    k = ActiveCell.Row 
    Cells(1, 1).Select 
    Response = MsgBox("удалить?", vbYesNo)
    If Response = vbYes Then
        s = 2
        For a = 2 To k
            Cells(s, 1).Select
            Select Case Cells(s, 9)
                Case "ооо пупкин":
                             s = s + 1
                Case "ЧП дерево":
                     s = s + 1
                Case "Т2":
                       s = s + 1
                Case "ФГУП мамба":    
                Case Else
                    Rows(s & ":" & s).Select
                    Selection.Delete Shift:=xlUp
            End Select
        Next a
    End If    
End Sub
 
eagl69, eagl69, без файла примера думаю тяжко будет, может нужно отключить обновление экрана
Код
Application.ScreenUpdating = False ' Отключаем обновление экрана
а затем после завершения включить
Код
Application.ScreenUpdating = 1 ' включаем обновление экрана
Не бойтесь совершенства. Вам его не достичь.
 
1. удалять строки по одной нужно циклом снизу вверх.
2. чтоб ускорить это - убрать обновление экрана и все селекты и активации.
 
eagl69, здравствуйте!
Цитата
eagl69: Скорость работы макроса
вместо такого названия для темы гораздо более подходящее —
Цитата
eagl69: удалить строки по условию
eagl69,
Цитата
Hugo: удалять строки по одной нужно циклом снизу вверх
если удалять циклом, то да, но можно в цикле собрать строки для удаления и удалить всё скопом, как показано тут. Быстрее будет только удаление одной областью после сортировки по критерию или фильтрация внутри кода с последующей вставкой массива целиком, но вам пока и этого хватит
Изменено: Jack Famous - 03.12.2019 16:36:48
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
удаление строк в файле большого размера - это невеселый процесс
обьедините строки в диапазон, удалите  этот диапазон одной командой  даже на очень "толстом" файле на это уйдет 5-10-30 секунд, но никак не полчаса
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
eagl69 Иногда очень тормозят вычисления (если есть формулы), потому используйте и
Код
 Application.Calculation = xlCalculationManual
 Application.Calculation = xlCalculationAutomatic
 
eagl69,
Цитата
skais675: Иногда очень тормозят вычисления
при удалении строк по одной в цикле отключение автопересчёта сильно поможет  :idea:
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Насоветовали много, а про
Код
           Cells(s, 1).Select

                 Rows(s & ":" & s).Select
                    Selection.Delete Shift:=xlUp
забыли. Это пример как не надо делать, за исключением тех случаев, когда нужно сделать интерактивное удаление и поуказать как двигается маркер.

Calculation, ,ScreenUpdating и EnableEvents вышесказанное не отменяет, ну и про порядок от последнего к первому тоже..
По вопросам из тем форума, личку не читаю.
 
А можно добавить полосу процесса? при выполнении цикла? или это увеличит время выполнения?
ка кэто можно реализовать?
 
Цитата
eagl69 написал:
А можно добавить полосу процесса?
Если сделать все правильно, то она будет не нужна, ибо все пролетит мгновенно.
Пример файла нет желания показать?
По вопросам из тем форума, личку не читаю.
 
Увеличит.
 
Цитата
БМВ: Насоветовали много, а [про селекты] забыли
Цитата
Hugo [в #2]: чтоб ускорить это - убрать обновление экрана и все селекты и активации
+ я дал готовое решение по ссылке
Цитата
eagl69: А можно …?
можно, увеличит, хотите - создавайте новую тему
Изменено: Jack Famous - 04.12.2019 09:19:43
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Код
Sub udal()
    ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Activate
    k = ActiveCell.Row 
     Response = MsgBox("Удалить", vbYesNo)
    не_удаляем = Array("ООО Пупкин", "ЧП1")
     If Response = vbYes Then
        Application.ScreenUpdating = False 
        For a = k To 1 Step -1
            If IsNumeric(Application.Match(Cells(a, 9), не_удаляем, 0)) Then
            ' 
            Else
            '
                Rows(a & ":" & a).Select
                Selection.Delete Shift:=xlUp
            End If
        Next a
        Application.ScreenUpdating = True 
    End If
End Sub

Попробовал так, тоже долго....
как замерить скорость?
 
Цитата
eagl69: как замерить скорость?
вопрос не по теме
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
eagl69 написал:
как замерить скорость?
вопрос не как - а зачем? Если результат действия макроса не устраивает по скорости, то как бы не замеряли, быстрее не станет. Замер нужен только для объективной оценки разных решений и подходов.

Hugo, пардон, не дочитал п.2 до конца :-)

eagl69,
Цитата
БМВ написал:
Пример файла нет желания показать?
Вам про Application.ScreenUpdating и про Calculating писали - где второе?
Код
Rows(a).Delete Shift:=xlUp
Изменено: БМВ - 04.12.2019 11:00:10
По вопросам из тем форума, личку не читаю.
 
Цитата
БМВ написал:
и про Calculating писали - где второе?
У меня по умолчанию перерасчет отключен, поэтому не делал. строк около 300 000 работает очень долго :(
 
Цитата
eagl69 написал:
работает очень долго
потому что надо удалять группами, в идеале как написано в №4
По вопросам из тем форума, личку не читаю.
 
eagl69, покажите пример файла.
В общем-то, больше интересует сколько строк/столбцов и память компа.
Есть ли формулы и нужны ли они после удаления строк, или достаточно оставить значения.
 
Код
Sub SameRowsDel()
  Const NoDel$ = "<ООО Пупкин><ЧП1>"
  Dim rg As Range, tm, c&, r&, r1, r2&, a, s$
  tm = Timer
  a = Columns(9)
  For r = 1 To ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
    If InStr(NoDel, "<" & a(r, 1) & ">") = 0 Then
      If s = "" Then
        s = r & "": r1 = r: r2 = r
      Else
        If r > r2 + 1 Then s = s & "," & r: r1 = r
        r2 = r
      End If
    Else
      If r = r2 + 1 Then s = s & ":" & r2
    End If
  Next
  If r - 1 = r2 Then s = s & ":" & r2: r1 = 255
  Do While Len(s) > r1
    r = InStr(Len(s) - r1, s, ",")
    If rg Is Nothing Then
      Set rg = Range(Right(s, Len(s) - r))
    Else
      Set rg = Union(rg, Range(Right(s, Len(s) - r)))
    End If
    s = Left(s, r - 1)
  Loop
  If s <> "" Then If rg Is Nothing Then Set rg = Range(s) Else Set rg = Union(rg, Range(s))
  If Not rg Is Nothing Then rg.Select
  MsgBox "убито " & Timer - tm & " сек."
End Sub
2-я строка с начала - там перечисленно, что нужно оставить на листе
2-я строка с конца - напишете вместо Select  Delete - все строки, что этот макрос отметил, будут удалены
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Выдает ошибку Run-time error '1004': в строке
If s <> "" Then If rg Is Nothing Then Set rg = Range(s) Else Set rg = Union(rg, Range(s))
что то с Range не сработало.
 
увидеть бы файл, на котором это произошло
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
Страницы: 1
Наверх