3

下面的代码是作为随机样本生成器的一部分编写的。根据发生的总数，它计算样本量并将总体减少到样本量。现在我通过删除总数和样本量之间的差异来做到这一点。我想看看是否有更好的方法来解决这个问题。我在用户定义的列中获取每个值的样本并使用大型数据集，因此采样最终需要几分钟。

有没有办法一次删除我需要的行数，而不是像下面的循环中看到的那样一次删除一个，或者有更好的方法来解决这个问题？谢谢！

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
4

3 回答 3

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
于 2013-03-19T05:48:36.707 回答
0

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

只需添加一个额外的列，创建一个可以使用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 列中添加了一个与 A 列中找到的 SubPop 匹配的公式
  2. 下一行找到所有这些行然后删除它们
  3. 最后一行清理

菲利普

于 2013-03-19T09:41:46.417 回答
-1

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

 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
于 2013-03-19T07:05:27.733 回答