获取具有另一列过滤范围的唯一列表

Question

我需要为 A 列中的每个唯一值提取 B 列中的唯一值。 我有一个帖子中的代码，但它列出了整个列的唯一值。 我想要的只是那些与我提供的过滤条件相关联的唯一值。

我需要将这些唯一值移动到一个数组中，并将其用于另一个工作表计算。 我到目前为止的代码如下。

Sub test()
    Dim TestRg As Excel.Range
    Dim Array1(200) As Variant
    Dim i, j As Integer
    i = 1
    
    Set TestRg = Range("L1:L181")
    TestRg.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        ActiveCell, Unique:=True
    For Each C In TestRg.SpecialCells(xlCellTypeVisible)
    If Not (C) Is Nothing Then
        Array1(i) = C.Value
        i = i + 1
    End If
    Next C
    j = i - 1
    i = 1

    
    For i = 1 To j
    Debug.Print Array1(i)
    Next
End Sub

请帮忙。

Answer 1

此宏将捕获活动表 A 列中所有可见单元格的所有不同值，并在 B 列中设置值。如果行隐藏在 B 列中，则可能无法按您的预期显示。

Sub findtheVisibleUniqueValues()
Dim sRange As Range, aCell As Range, i As Long
Dim ws As Worksheet
    Set ws = ActiveSheet
    
ReDim zRay(1 To 1, 1 To 1)
i = 1

Set sRange = Intersect(ws.Range("A:A"), ws.UsedRange)

For Each aCell In sRange.Cells
    If aCell.EntireRow.Hidden = True Then
        'skip
    ElseIf Not (checkForMatch(aCell.Value, zRay)) Then
            ReDim Preserve zRay(1 To 1, 1 To i)
            zRay(1, i) = aCell.Value
            i = i + 1
    End If

Next aCell

'Your array is complete.
'This will insert to Column B (note if rows are hidden, it may not display correctly)

ws.Range("B1").Resize(UBound(zRay, 2), 1).Value = Application.WorksheetFunction.Transpose(zRay)

End Sub



Private Function checkForMatch(theValue As Variant, theArray()) As Boolean
Dim g As Long, j As Long

For j = LBound(theArray) To UBound(theArray)
    For g = LBound(theArray, 2) To UBound(theArray, 2)
        If theValue = theArray(j, g) Then
            checkForMatch = True
            Exit Function
        End If
    Next g
Next j

End Function