删除行循环优化 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

对于此解决方案，可以避免循环。

只需添加一个额外的列，即可使用 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

最后，清理/删除我们在开头添加的额外公式列：

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 匹配的公式 在 A 列中
2. 下一行查找所有这些行，然后将其删除
3. 最后一行清理

菲利普

Answer 3

对于这种情况，循环是无法避免的。 试试下面的代码。

 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