Страницы: 1
RSS
Наиболее быстрый способ удаления строк VBA
 
Всем добрый вечер. Возник вопрос, каким способом можно наиболее быстро удалить строки в примере во вложении. Необходимо удалить все строки с минимальной датой. Дело в том в реальности строк в файле под миллион, циклы и фильтры очень тяжело работают.
 
Как вариант - отсортировать по дате, прогнать цикл до первой даты большей минимально, удалить строки с первой до найденной минус одна.
Если сортировка неприемлема и последовательность важна, то сначала в свободную колонку записать текущий номер строки, потом выполнить вышеперечисленные действия и отсортировать по столбцу куда записывались номера строк.
Не стреляйте в тапера - он играет как может.
 
Цитата
Ts.Soft написал:
и последовательность важна, то сначала в свободную колонку
поставить метку. Отсортировать по этому столбцу,  выделить диапазон с меткой и удалить. Остальные строки останутся в прежней сортировке и без ненужных строк.
Изменено: БМВ - 04.10.2018 23:11:55
По вопросам из тем форума, личку не читаю.
 
Может, так попробовать?
Код
Sub Stroki()
   ThisWorkbook.Worksheets("Лист1").Activate
   Dim i As Long
   Dim lr As Long
   Dim R As Long
   Dim NR As Long
   Dim a
   i = Evaluate("MIN(A:A)")
   lr = Worksheets("Лист1").Cells(Rows.Count, 1).End(xlUp).Row
   a = Worksheets("Лист1").Range("A2:A" & lr) 'если нужно больше столбцов в массиве - добавьте
   ReDim b(1 To UBound(a), 1 To 1)            'с первого по первый столбец (добавьте, если нужно больше)
   For R = 1 To UBound(a)
   If a(R, 1) <> i Then
       NR = NR + 1
       b(NR, 1) = a(R, 1)
       End If
   Next R
       Worksheets("Лист1").Range("A2:A" & lr).ClearContents
       Worksheets("Лист1").Range("A2").Resize(NR) = b
End Sub
p.s. Если столбцов не очень много, то зачем удалять полностью строки
Изменено: _Igor_61 - 04.10.2018 23:34:12
 
Код, аналогичный коду _Igor_61, попробуйте:
Код
Option Explicit

Sub bez_min_daty()
Dim r&, c%, i&, j%, k&, min_date, tbl_tmp(), tbl()
Dim tmr!: tmr = Timer

    With Application
        .ScreenUpdating = False: .DisplayAlerts = False
        .EnableEvents = False: .Calculation = xlManual
    End With
    
    With Range("a1").CurrentRegion
        r = .Rows.Count - 1: c = .Columns.Count
        min_date = Application.Min(.Offset(1, 0).Resize(r, 1))
        tbl_tmp = .Offset(1, 0).Resize(r, c).Value
    End With
    
    For i = 1 To r
        If tbl_tmp(i, 1) <> min_date Then k = k + 1
    Next
    
    ReDim tbl(1 To k, 1 To c): k = 0
    
    For i = 1 To r
        If tbl_tmp(i, 1) <> min_date Then
            k = k + 1
            For j = 1 To c
                tbl(k, j) = tbl_tmp(i, j)
            Next
        End If
    Next
    
    Erase tbl_tmp
    
    With Range("a1").CurrentRegion.Offset(1, 0)
        .Resize(r, c).Clear: .Resize(k, c).Value = tbl
    End With
    
    Erase tbl
    
    With Application
        .Calculation = xlAutomatic: .EnableEvents = True
        .DisplayAlerts = True: .ScreenUpdating = True
    End With
    
    MsgBox "Ves' protsess prodolzhalsya: " & CStr(Round(Timer - tmr, 4)) & " s", vbOKOnly, "Info !"
End Sub
Изменено: ocet p - 05.10.2018 01:32:26
 
Был быстрый код от ZVI (через сортировку). Найду - выложу. Или буду у ПК - выложу слегка доработанный.
«Бритва Оккама» или «Принцип Калашникова»?
 
Вот нашел от ZVI
Код
==============================================================
Мне необходимо удалить строки со нулевыми значиниями из Листа, но там порядка 200 000 строк.
ZVI 
Процедура очистки(удаления) строк в столбце ColNum со значениями DelValue: 
'===================================================================================
' Sub         : DelRows(TableHeader,ColNum,DelValue)
' TableHeader : Range; table header range
' ColNum      : Long; column number with DelValue
' DelValue    : Variant; value of rows to be deleted
'-------------+---------------------------------------------------------------------
' VBA call    : DelRows ActiveSheet.Range("A1:H1"), 5, 0
'-------------+---------------------------------------------------------------------
' Created     : ZVI:2009:12:26 [url]http://www.sql.ru/forum/actualthread.aspx?tid=722758[/url]
'-----------------------------------------------------------------------------------
Sub DelRows(TableHeader As Range, ColNum As Long, DelValue)
  Dim Arr(), r&, rs&, cs&, i&, v, ac
  With TableHeader.CurrentRegion
    rs = .Rows.Count - TableHeader.Row + .Row
    cs = .Columns.Count - TableHeader.Column + .Column
  End With
  With TableHeader.Resize(rs, 1)
    Arr() = .Offset(, cs).Value
    ' Check DelValue
    For Each v In .Offset(, ColNum - 1).Value
      r = r + 1
      If v <> DelValue Then
        i = i + 1
        Arr(r, 1) = 1
      End If
    Next
    If i < rs Then
      ' Freeze on
      With Application
        .ScreenUpdating = False
        .EnableEvents = False
        ac = .Calculation: .Calculation = xlCalculationManual
      End With
      ' Delete rows with DelValue in ColNum
      .Offset(, cs) = Arr
      .Resize(, cs + 1).Sort .Cells(1).Offset(, cs), 1, Header:=xlNo
      .Resize(, 1).Offset(, cs).ClearContents
      .Resize(rs - i, cs).Offset(i).Clear   ' или .Resize(rs - i).Offset(i).EntireRow.Delete
      ' Freeze off
      With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = ac
      End With
    End If
  End With
End Sub
 
 
Тестирование:
 
Sub Test()
  DelRows ActiveSheet.Range("A1:H1"), 5, 0
End Sub

Отсюда.
«Бритва Оккама» или «Принцип Калашникова»?
 
Допилиливал код, когда не требуется доп. столбец. Если будет нужно выложу.
«Бритва Оккама» или «Принцип Калашникова»?
 
Цитата
написал:
Допилиливал код, когда не требуется доп. столбец. Если будет нужно выложу.
Можно посмотреть код, без доп. столбца?
Понимаю, что прошло уже 4ре года...
 
https://www.excel-vba.ru/forum/index.php?topic=5674.msg30322#msg30322
 
RAN, судя по Return, это не VBA  :)
Ну а так наиболее высокая скорость будет только при удалении одного сплошного диапазона, что возможно только при сортировке.
Все остальные варианты можно ускорить за счёт нарезания строки адресов для укрупнения диапазонов и быстрого получения буквы столбца по его номеру (для получения адреса)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
Jack Famous написал:
судя по Return, это не VBA  
в VBA тоже есть return.
Цитата
Александр Усков написал:
Можно посмотреть код
если найду, скину. Там весь смысл в том, что сортируем сразу по ключевому столбцу, первоначально правильно его подготовив/заполнив.
Изменено: bedvit - 15.06.2022 10:21:03
«Бритва Оккама» или «Принцип Калашникова»?
 
Цитата
bedvit: смысл в том, что сортируем сразу по ключевому столбцу, первоначально правильно его подготовив/заполнив
прикольно, кстати!  :idea: Можно приклеить слева индексы в виде "!000123" (или заменить значения всех ячеек удаляемых строк на "!!! $%$ !!!" например) для сортировки и всё готово. Отличная идея!

Цитата
bedvit: в VBA тоже есть return
как использовать и для чего нужен? Так вызывает ошибку

Цитата
Jack Famous: наиболее высокая скорость будет только при удалении одного сплошного диапазона
если задача позволяет, то можно собрать новый массив без "удаляемых" строк и выгрузить в старый или другое место — это ещё быстрее
Изменено: Jack Famous - 15.06.2022 10:35:28
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
Jack Famous написал:
судя по Return, это не VBA
Код
GoSub sRange
 
RAN, не заметил)) теперь я понимаю, какой переход по меткам не любят - вот такой  :D
Какой смысл скакать в конец и потом возвращаться, если это просто ветка If…Then?…
Простите за оффотоп и докопательство - я хоть сам и люблю метки, но вот тут не понимаю, правда  :)
Было и стало
Изменено: Jack Famous - 15.06.2022 11:09:32
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
Jack Famous написал:
это просто ветка If…Then?
Это не так.
GoSub - как вариант - это замена функции - не нужно передавать параметры и не нужны глобальные переменные.
Пример здесь
И здесь
Думаю есть и другие применения GoSub , но я пользуюсь именно этими функционалом.
«Бритва Оккама» или «Принцип Калашникова»?
 
Цитата
bedvit: Это не так
это ТАК.
Если можно заменить обычной веткой, то зачем:
    1. перескакивать в конец процедуры
    2. Возвращаться обратно
    3. Не забыть выйти из процедуры перед блоком GoSub

В применении меток я руководствуюсь тем, что без них код был бы больше, ветвистее и/или запутаннее.
Применяю обычно для перехода к следующему элементу цикла, выхода из множества вложенных циклов, прыжка назад (например при необходимости повторного ввода пользователем, пока не введёт правильно) или прыжка в конец, чтобы отобразить общее для множества ситуаций сообщения и/или "включения" обратно всех Application (нужно и в случае аварийного выхода и при штатной работе).

Кому как удобно конечно, но я для GoSub пока у себя нигде применения не вижу, а в этом конкретном случае показал, как безболезненно он заменяется на обычное ветвление.
Изменено: Jack Famous - 15.06.2022 13:45:42
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
Александр Усков написал:
Можно посмотреть код, без доп. столбца?
Нашел отрывки, скомпилировал в целый
Код
Sub DelRows_20220615() ' - для форума, без доп. поля
Dim rStart, rEnd, cStart, cEnd, keyColumn, Rng, arr(), arr2(), v, r, key, i
        
keyColumn = 1 'задаем ключевой столбец, по которому проверяем условия для удаления строк
key = 4 'задаём ключ по которому будем отбирать в ключевом столбце значения

With ActiveSheet.UsedRange 'определим границы диапазона по на активном листе
    rStart = .Row: rEnd = .Row + .Rows.count - 1  'задаем  границы диапазона строк
    cStart = .Column:  cEnd = .Column + .Columns.count - 1 'задаем  границы диапазона столбцов
End With

Set Rng = Range(Cells(rStart, 1), Cells(rEnd, cEnd)) 'берем с 1го, что бы не запутаться с keyColumn 
arr() = Rng.Resize(, 1).Offset(, keyColumn - 1).Value 'ключевой столбец
arr2() = arr 'ключевой столбец - копия

With Rng
    For r = 1 To .Rows.count
        v = arr(r, 1)
        If Not IsError(v) Then If v = key Then i = i + 1: arr2(i, 1) = arr(r, 1): arr(r, 1) = i Else arr(r, 1) = ""
    Next

    If i < .Rows.count And i Then 'если найдены нужные данные и их меньше чем исходный диапазон
        .Resize(, 1).Offset(, keyColumn - 1).Value = arr() 'ключ для сортировки
        .Sort .Resize(, 1).Offset(, keyColumn - 1), 1, Header:=xlNo 'данные без заголовка
        .Resize(i, 1).Offset(, keyColumn - 1).Value = arr2() 'ключ изначальный только по нужным
        .Resize(.Rows.count - i).Offset(i).Delete Shift:=xlUp  'удаляем остаток
    End If
End With
    
End Sub
Изменено: bedvit - 15.06.2022 14:40:26
«Бритва Оккама» или «Принцип Калашникова»?
 
Jack Famous, замени в моем коде так же безболезненно
Цитата
Jack Famous написал:
обычной веткой
Вот пример (высылал ранее первой ссылкой)
Изменено: bedvit - 15.06.2022 14:21:22
«Бритва Оккама» или «Принцип Калашникова»?
 
Цитата
написал:
Нашел отрывки, скомпилировал в целый
Огромное спасибо!
 
Цитата
bedvit: замени в моем коде так же безболезненно
я не говорил, что везде можно заменить веткой — опять ты выдумываешь, фантазёр  :D
У тебя 2 обращения и тут уже альтернатива только процедура — с параметрами (много) или глобальными общими переменными. У тебя это ещё хоть как-то уместно (хотя в моём SmartUnion'е я обошёлся без таких сложностей)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
Jack Famous написал:
опять ты выдумываешь, фантазёр
Где я выдумывал хоть раз? Укажи.

Если ты говоришь, про конкретный случай, то я его не смотрел, возможно код можно оптимизировать (мой ответ был не про этот случай, а про GoSub (+Return))

Если мы говорим про GoSub (+Return) и про то,
Цитата
Jack Famous написал:
как использовать и для чего нужен?
Я тебе ответил, где используют и для каких случаев он нужен.
Изменено: bedvit - 15.06.2022 14:48:02
«Бритва Оккама» или «Принцип Калашникова»?
 
Цитата
bedvit: Я тебе ответил, где используют и для каких случаев он нужен
Цитата
bedvit: GoSub - как вариант - это замена функции - не нужно передавать параметры и не нужны глобальные переменные
спасибо  :idea:
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
Jack Famous написал:
Если можно заменить обычной веткой, то зачем
Не помню, почему в этом случае моей левой задней ноге захотелось написать именно так.
Цитата
Jack Famous написал:
то зачем:     1. перескакивать в конец процедуры     2. Возвращаться обратно
А зачем выносить фрагмент кода в отдельную процедуру? Выходить из основной, и возвращаться обратно?
Цитата
Jack Famous написал:
Не забыть выйти из процедуры перед блоком GoSub
Это даже не смешно. Не забыть внешнюю процедуру определить как Sub или Fanction.
А то, что ты с наскока не видишь пряники, так бывает...
Страницы: 1
Наверх