Delete Row Loop Optimization VBA

Question

Код ниже был записан как часть генератора случайных выборок. Основываясь на общем количестве случаев, он вычисляет размер выборки и уменьшает популяцию до размера выборки. Сейчас я делаю это, удаляя разницу между общим и размером выборки. Я хотел бы посмотреть, есть ли лучший способ обойти это. Я получаю образец каждого значения в определенном пользователем столбце и работаю с большим набором данных, поэтому выборка заканчивается на несколько минут.

Есть ли способ удалить количество строк, которые мне нужны всем сразу, вместо того, чтобы делать их по одному, как показано в цикле ниже, или лучший способ обойти это в целом? Спасибо!

x = (Population - SampleSize) 

    If Population > SampleSize Then 
     Do Until x = 0 
      Workbooks(SourceBook).Sheets(SampleSheet).Columns(StratCol) _ 
      .Find(What:=SubPop, After:=Cells(SampRows, StratCol), LookIn:=xlValues, _ 
       SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
       MatchCase:=False, SearchFormat:=False).EntireRow.Delete 

     x = x - 1 

     Loop 

    End If 

Answer 1

Вы можете создать диапазон, содержащий несколько несмежных строк, а затем удалить все из них одновременно. Это, вероятно, ускорит все.

Answer 2

Для этой ситуации нельзя избежать. Попробуйте под кодом.

Dim rng As Range 
    x = (Population - SampleSize) 

    If Population > SampleSize Then 
     Do Until x = 0 

      With Workbooks(SourceBook).Sheets(SampleSheet) 
       Set rng = .Columns(StratCol).Find(What:=SubPop, After:=Cells(SampRows, StratCol)) 
       If Not rng Is Nothing Then 
        rng.EntireRow.Delete 
       End If 
      End With 

      x = x - 1 
     Loop 
    End If 

Answer 3

для этого решения петля может избежать.

Просто добавьте дополнительный столбец создает ошибку, которая может быть найдена с помощью SpecialCells, как показано ниже:

Range("IA1:IA" & Range("A65536").End(xlUp).Row).Formula = "=IF(A:A = """ & SubPop & """,NA(),"""") " 

затем вы используете SpecialCells, чтобы определить строки, соответствующие SupPop и удалить всю строку!

Range("IA1:IA" & Range("A65536").end(xlup).row).specialcells(xlCellTypeFormulas, xlErrors).EntireRow.Delete shift:=xlup 

Наконец, очистка/удаление, который мы добавили в начале дополнительную формулу colummn:

Range("IA1:IA" & Range("A65536").end(xlup).row).clear 

Вот правильное объяснение этого метода: How to delete multiple rows without a loop in Excel VBA

Я надеюсь, что помогает получить вы запустили

и вот приведенный выше код все в одном виде с нетерпением запрошен:

Sub deleteRows(ByVal strSubPop As String) 
' pass in the string to match (SubPop) 
' 
    Range("IA1:IA" & Range("A65536").End(xlUp).Row).Formula = "=IF(A:A = """ & strSubPop & """,NA(),"""") " 
'  
    ' for debugging and testing just select the rows where a match is found 
    Range("IA1:IA" & Range("A65536").End(xlUp).Row).SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Select 
' 
    ' when ready, UNCOMMENT the below line 
    ' Selection.Delete shift:=xlUp 
    ' 
    ' after testing just use this line to select the rows and delete in one step: 
    ' Range("IA1:IA" & Range("A65536").End(xlUp).Row).SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Delete shift:=xlUp 
    ' 
    ' now clean up Column IA 
    Range("IA1:IA" & Range("A65536").End(xlUp).Row).Clear 
    Range("A1").Select 
' 
End Sub 

так что это за код делает?

Сначала ваше требование, чтобы удалить строки соответствия SubPop

1. Первая строка добавляет формулу в колонке IA, совпадающей SubPop найден в колонке А
2. Следующая строка находит все те строки, затем удаляет их
3. последняя строка очищает

Филипп