VBA 過濾列存儲另一列的唯一值

Question

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

1. 過濾列 A
2. 從 B 列中獲取唯一值

所以給定下表...

我想在 A 列中過濾“One”並返回一個數組，我可以像這樣粘貼到 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)

有了這個 function：

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

我擔心的是它沒有抓取過濾后的數據。 我相信它抓住了一切。 我在刪除重復項 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

Answer 2

假設您有 Office 365 並且沒有提及僅 VB 的解決方案，這可以使用工作表函數本身來實現

=UNIQUE(FILTER(B:B,A:A=A1))