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

最后，清理/删除我们在开头添加的额外公式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

匹配的行

第一行在列IA中添加了与找到的SubPop匹配的公式在A栏
下一行找到所有这些行，然后删除它们
最后一行清理

菲利普

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

删除行循环优化VBA

3 个答案: