刪除行循環優化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

您可以構建一個包含多個非連續行的範圍，然後一次刪除所有這些行。這可能會加速一些事情。

x = (Population - SampleSize) 

dim MyRange as Range 

If Population > SampleSize Then 
    Do Until x = 0 
     if MyRange Is Nothing Then 
      Set MyRange = Workbooks(SourceBook).Sheets(SampleSheet).Columns(StratCol) _ 
       .Find(What:=SubPop, After:=Cells(SampRows, StratCol), LookIn:=xlValues, _ 
       SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
       MatchCase:=False, SearchFormat:=False).EntireRow 
     Else 
      Set MyRange = Application.Union(MyRange, Workbooks(SourceBook).Sheets(SampleSheet).Columns(StratCol) _ 
       .Find(What:=SubPop, After:=Cells(SampRows, StratCol), LookIn:=xlValues, _ 
       SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
       MatchCase:=False, SearchFormat:=False).EntireRow) 
     End If 
     x = x - 1 
    Loop 
    MyRange.Delete 
End If 

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. 第一行增加了在匹配SubPop在列中找到 柱IA一個式A
2. 下一行查找所有那些行然後刪除他們
3. 最後一行清理

菲利普