Выбор N-й строки отфильтрованных данных

Question

Я хочу пометить указанные строки таблицы для выборочного просмотра.

Из-за объема данных выполнение повторяющихся циклов по всей совокупности приведет к недопустимо долгому времени выполнения (так как мне нужно пометить указанную подпрограмму -популяции для выборки QA).

Подход, который я выбрал, состоит в том, чтобы внести в таблицу, а затем отфильтровать по совокупности, которую я хочу отобрать (например, отфильтровать по местоположению, по продукту и по аналитику ), а затем выберите процент этой популяции для выборки, поместив «Выборка» в столбец.

Я пробовал несколько перестановок кода.

Первый, где я использовал функцию областей, выдает 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

Автофильтры могут создавать несмежные диапазоны с несколькими областями, что может быть проблематично c для нормальных диапазонов. Одним из способов является l oop через видимые ячейки и создание массива адресов (или строк). Затем, выбрав произвольно выбранный элемент массива, вы можете получить адрес ячейки в видимом диапазоне. Например

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