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

2024-05-20 • 问答

我需要为 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

请帮忙。

此宏将捕获活动表 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

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

hudiejuanjuan 回答：获取具有过滤范围的另一列的唯一列表

大家都在问