excel - VBA过滤器列存储另一列的唯一值

Question

我正在努力完成以下工作。

过滤A列

从 B 列中获取唯一值

所以给定下表...

我想在 A 列和 中过滤“一”返回一个数组，我可以将其粘贴到 C 列 像这样...

我曾尝试使用字典，但我对它的工作原理知之甚少。可能有数千行，因此速度可能是一个问题，如果没有必要，我宁愿不要遍历每一行。
我见过使用高级过滤器带回列的唯一值的解决方案，但从来没有过滤一列然后使用过滤结果来获取唯一值列表的组合。
我尝试过的代码示例(部分):

On Error Resume Next
    enterpriseReportSht.ShowAllData
On Error GoTo 0
With enterpriseReportSht
    .AutoFilterMode = False
    With .Range(Cells(1, 1).Address, Cells(entRptLR, entRptLC).Address)
        .AutoFilter Field:=manLevel2CN, Criteria1:=userInputsArr(i, manLevel2InputCN)
        '.SpecialCells(xlCellTypeVisible).Copy Destination:=resultsSht.Range("A1")
    End With
End With
filteredColArr = enterpriseReportSht.UsedRange.columns(manLevel4CN).Value
RemoveDuplicatesFromArray (filteredColArr)

使用此功能:

Public Function RemoveDuplicatesFromArray(sourceArray As Variant)
Dim duplicateFound As Boolean
Dim arrayIndex As Integer, i As Integer, j As Integer
Dim deduplicatedArray() As Variant

arrayIndex = -1
deduplicatedArray = Array(1)

For i = LBound(sourceArray) To UBound(sourceArray)
    duplicateFound = False

    For j = LBound(deduplicatedArray) To UBound(deduplicatedArray)
        If sourceArray(i) = deduplicatedArray(j) Then
            duplicateFound = True
            Exit For
        End If
    Next j

    If duplicateFound = False Then
        arrayIndex = arrayIndex + 1
        ReDim Preserve deduplicatedArray(arrayIndex)
        deduplicatedArray(arrayIndex) = sourceArray(i)
    End If
Next i

RemoveDuplicatesFromArray = deduplicatedArray
End Function

我担心的是它没有抓取过滤后的数据。我相信它捕获了一切。我也收到了删除重复功能的错误。

Answer 1

这应该可以满足您使用字典的要求。
您可以通过将范围加载到数组中并对其进行迭代来加速它，但是使用过滤范围以及获取二维数组的上限有点痛苦，您需要转置它首先进入一维数组。除非您注意到速度真的很慢，否则可能不值得。我用 15k 行测试它是 < 1 秒。

    Dim i As Long
    Dim lr As Long
    Dim filterrange As Range
    
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    
    
    With Sheet1 'Change as needed
        lr = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set filterrange = .Range(.Cells(1, 1), .Cells(lr, 2))
        filterrange.AutoFilter 1, "One"
        
        lr = .Cells(.Rows.Count, 1).End(xlUp).Row 'Only really necessary if you have a lot of rows
        
        For i = 1 To lr
            If .Rows(i).EntireRow.Hidden = False Then
                If Not dict.exists(.Cells(i, 2).Value) Then
                    dict.Add .Cells(i, 2).Value, ""
                End If
            End If
        Next i
        filterrange.AutoFilter
        
        Dim key As Variant
        i = 1
        For Each key In dict
            .Cells(i, 3).Value = key
            i = i + 1
        Next key
    End With