选择第N行过滤数据

Question

我想要标记表格中指定的行，以供样本查看。

由于数据量的原因，在整个总体上运行重复循环将导致不可接受的长运行时间(因为我必须标记指定的子总体以进行QA采样)。

我采取的方法是引入表，然后根据我想要采样的总体进行过滤(例如，按位置、产品和分析师进行过滤)，然后通过将" sample“放入一列来选择该总体中的一个百分比进行采样。

我已经尝试了代码的几种排列。

第一个是我使用Areas函数的地方，如果有超过一行，就会抛出1004个错误。

第二个给出了奇怪的行选择，包括选择非隐藏行(我不能理解它为什么要选择它本身的行，因为它们似乎没有被正确地偏移，即使它是通过“所有行”而不仅仅是可见行)。

        ActiveSheet.ListObjects("SourceDataTable").Range.AutoFilter Field:=1, Criteria1:="Product1"
        sectionCount = ActiveSheet.ListObjects("SourceDataTable").AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1
        If sectionCount = 0 Then sectionSampleSize = 0 Else sectionSampleSize = Int((sectionCount / 10) + 0.5)
        MsgBox ("Analyst " & analystLoopCellRef.Value & " ecomm section count is " & sectionCount & " and sample size is " & sectionSampleSize)

        Do While sectionSampleSize > 0

            sectionLoopRand = Int(sectionCount * Rnd + 1)

            MsgBox (sectionLoopRand)
'            MsgBox (ActiveSheet.ListObjects("SourceDataTable").DataBodyRange.SpecialCells(xlCellTypeVisible).Areas(1).Columns(40).Rows(sectionLoopRand).Cells(1, 1).Value)

            If ActiveSheet.ListObjects("SourceDataTable").DataBodyRange.SpecialCells(xlCellTypeVisible).Columns(40).Rows(sectionLoopRand).Cells(1, 1).Value = "Sample" Then
                MsgBox ("Sample overlap")
            Else
                ActiveSheet.ListObjects("SourceDataTable").DataBodyRange.SpecialCells(xlCellTypeVisible).Columns(40).Rows(sectionLoopRand).Cells(1, 1).Value = "Sample"
'                MsgBox ("Sample address is " & ActiveSheet.ListObjects("SourceDataTable").DataBodyRange.SpecialCells(xlCellTypeVisible).Columns(40).Rows(sectionLoopRand).Cells(1, 1).Address)
                sectionSampleSize = sectionSampleSize - 1
'                MsgBox ("Sample selected")
            End If


        Loop

旧版本

        ActiveSheet.ListObjects("SourceDataTable").Range.AutoFilter Field:=1, Criteria1:="Product1"
        sectionCount = ActiveSheet.ListObjects("SourceDataTable").AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1
        If sectionCount = 0 Then sectionSampleSize = 0 Else sectionSampleSize = Int((sectionCount / 10) + 0.5)
        MsgBox ("Analyst " & analystLoopCellRef.Value & " ecomm section count is " & sectionCount & " and sample size is " & sectionSampleSize)

        Do While sectionSampleSize > 0

            sectionLoopRand = Int(sectionCount * Rnd + 1)

            MsgBox (sectionLoopRand)
'            MsgBox (ActiveSheet.ListObjects("SourceDataTable").DataBodyRange.SpecialCells(xlCellTypeVisible).Areas(sectionLoopRand).Columns(40).Cells(1, 1).Value)

            If ActiveSheet.ListObjects("SourceDataTable").DataBodyRange.SpecialCells(xlCellTypeVisible).Areas(sectionLoopRand).Columns(40).Cells(1, 1).Value = "Sample" Then
                MsgBox ("Sample overlap")
            Else
                ActiveSheet.ListObjects("SourceDataTable").DataBodyRange.SpecialCells(xlCellTypeVisible).Areas(sectionLoopRand).Columns(40).Cells(1, 1).Value = "Sample"
''                MsgBox ("Sample address is " & ActiveSheet.ListObjects("SourceDataTable").DataBodyRange.SpecialCells(xlCellTypeVisible).Areas(sectionLoopRand).Columns(40).Cells(1, 1).Address)
                sectionSampleSize = sectionSampleSize - 1
'                MsgBox ("Sample selected")
            End If


        Loop

Answer 1

自动过滤器可以创建具有多个区域的非连续范围，这对于正常的范围方法来说可能是有问题的。一种方法是循环遍历可见单元并构建地址(或行)的数组。然后，通过随机选择一个数组元素，您可以获得可见范围内的单元格的地址。例如

Option Explicit
Sub mysample()

    Const TABLE_NAME = "SourceDataTable"
    Const FILTER_COL = 1
    Const TABLE_COL = 40 ' word sample added in table col 40

    Const SAMPLE_TERM = "Product1"
    Const SAMPLE_RATE = 10 ' 1 in 10 sampled
    Const LOOP_MAX = 10000 ' avoid infinite while loop

    Dim wb As Workbook, ws As Worksheet
    Dim tbl As ListObject, rng As Range, t0 As Single
    t0 = Timer

    Set wb = ThisWorkbook
    Set ws = wb.ActiveSheet

    ' apply filter and set rng to visible cells in filter col
    Set tbl = ws.ListObjects(TABLE_NAME)
    tbl.Range.AutoFilter Field:=FILTER_COL, Criteria1:=SAMPLE_TERM
    Set rng = tbl.Range.Columns(FILTER_COL).SpecialCells(xlCellTypeVisible)
    Debug.Print rng.Address, rng.Cells.Count

    ' build myrows array of addresses from rng.cells
    Dim iCount As Integer, myrows() As String, cell As Range
    iCount = -1 ' myrows(0) will be header
    ReDim myrows(rng.Cells.Count)
    For Each cell In rng.Cells
        iCount = iCount + 1
        myrows(iCount) = cell.Address
        'Debug.Print iCount, cell.Address, cell.Row
    Next

    ' determine sample size
    Dim iSampleSize As Integer
    If iCount > SAMPLE_RATE / 2 Then
        iSampleSize = Round(iCount / SAMPLE_RATE, 0)
    End If
    'Debug.Print iSampleSize

    ' select sample
    Dim n As Integer, x As Integer, z As Integer
    n = 0
    Do While n < iSampleSize

        ' pick one at random
        x = 1 + Int(Rnd * iCount) ' avoid header row 0
        'Debug.Print n, x

        ' update table if not previously chosen
        If Len(myrows(x)) > 0 Then
            ws.Range(myrows(x)).Offset(0, TABLE_COL - FILTER_COL) = "Sample"
            myrows(x) = "" ' avoid repeat
            n = n + 1
        End If

        z = z + 1 ' avoid endless loop
        If z > LOOP_MAX Then
            MsgBox "Max iterations in While Loop exceeded", vbCritical
            Exit Sub
        End If

    Loop
    MsgBox iSampleSize & " items selected from " & iCount, vbInformation, "Completed in " & Int(Timer - t0) & " secs"

End Sub