使用列中的特定值进行计数

Question

我这里有一个小代码，用于获取状态值“待处理 A”和“待处理 B”的 ID 总数。这是我下面的工作表，称为 Sheet1。

1201    Pending A
1202    In progress
1203    Pending A
1204    Pending B
1205    Pending C
1206    Pending B
1207    Pending B

这是我试图用于我想要的输出的代码。

Private Sub UserForm_Initialize()
        Dim ws As Worksheet, rng As Range, count As Long, K As Long
        Dim arrData, arrList(), i As Long, j As Long
        Set ws = Worksheets("Sheet1")
        
        Set rng = ws.Range("A1:B" & ws.Cells(Rows.count, "B").End(xlUp).Row)
        arrData = rng.Value
        
        count = WorksheetFunction.CountIfs(rng.Columns(2), "Pending A" Or rng.Columns(2), "Pending B")
        ReDim arrList(1 To count + 1, 1 To UBound(arrData, 2))
        
        For i = 2 To UBound(arrData)
            If arrData(i, 2) = "Pending A" Or "Pending B" Then
                K = K + 1
                For j = 1 To UBound(arrData, 2)
                    arrList(K, 1) = arrData(i, 1)
                    arrList(K, 2) = arrData(i, 2)
                Next
            End If
        
        Next
             
        With Me.ListBoxTrial
            .ColumnHeads = False
            .ColumnWidths = "30,30"
            .ColumnCount = UBound(arrData, 2)
            .List = arrList
        End With
        
        Label1.Caption = count
End Sub

我收到一条错误消息，下面没有黄色标记。

这是我想要的输出。

请指教。 TY

Answer 1

使用集合来计算并保存匹配的行号

Private Sub UserForm_Initialize()
        
    ' Define constants.
    Const CRITERIA_COLUMN As Long = 2
    
    ' Return the values of the range in an array.
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet: Set ws = wb.Sheets("Sheet1")
    Dim rng As Range:
    Set rng = ws.Range("A1:B" & ws.Cells(ws.Rows.Count, "B").End(xlUp).Row)
    Dim sRowsCount As Long: sRowsCount = rng.Rows.Count
    Dim ColumnsCount As Long: ColumnsCount = rng.Columns.Count
    Dim sData() As Variant: sData = rng.Value
    
    ' Return the matching source row numbers in a collection.
    Dim coll As Collection: Set coll = New Collection
    Dim sr As Long
    For sr = 2 To sRowsCount
        Select Case CStr(sData(sr, CRITERIA_COLUMN))
            Case "Pending A", "Pending B"
                coll.Add sr
        End Select
    Next sr
    
    ' Define the destination array
    Dim dRowsCount As Long: dRowsCount = coll.Count
    If dRowsCount = 0 Then Exit Sub ' no matches
    Dim dData() As Variant: ReDim dData(1 To dRowsCount, 1 To ColumnsCount)
    
    ' Loop through the items (matching source rows) of the collection
    ' to populate the destination array.
    Dim srItem As Variant, dr As Long, c As Long
    For Each srItem In coll
        dr = dr + 1
        For c = 1 To ColumnsCount
            dData(dr, c) = sData(srItem, c)
        Next c
    Next srItem
         
    ' Populate the listbox...
    With Me.ListBoxTrial
        .ColumnHeads = False
        .ColumnWidths = "30,30"
        .ColumnCount = ColumnsCount
        .List = dData
    End With
    ' ... and the label.
    Label1.Caption = dRowsCount
        
End Sub