删除行循环优化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. 最后一行清理

菲利普