excel - 使用自动筛选从工作表中查找列中的唯一值

Question

我已经自动过滤了一个工作表，并试图在过滤后的数据中建立唯一值。我觉得我有正确的方法，但我的结果只显示了可能的 8 个唯一值中的 2 个。

Private Sub GetAllCampusDomains(DomainCol As Collection)
    Dim data(), dict As Object, r As Long, i%, lastrow As Long
    Set dict = CreateObject("Scripting.Dictionary")
       
    'Clear the previous filter
    shtData.ShowAllData
    
    'Filter the data
    shtData.Range("A:Y").AutoFilter Field:=6, Criteria1:=shtSetup.Range("CampusName") 'SchoolName
    shtData.Range("A:Y").AutoFilter Field:=9, Criteria1:="DomainPerformance" 'ColI
           
    'Inspect the visible cells in ColP
    lastrow = shtData.Cells(shtData.Rows.Count, "P").End(xlUp).row
    data = shtData.Range("P2:P" & lastrow).SpecialCells(xlCellTypeVisible)
    
    'Find the unique values
    For r = 1 To UBound(data)
        dict(data(r, 1)) = Empty
    Next
    data = WorksheetFunction.Transpose(dict.keys())
    
    'Walk through the unique values
    For i = 1 To UBound(data)
        Debug.Print data(i, 1)
        'DomainCol.Add data(i, 1)
    Next i
End Sub

该错误似乎与这一行有关:
数据 = shtData.Range("P2:P"& lastrow).SpecialCells(xlCellTypeVisible)
这个调用似乎只创建了一个 90x1 大小的数组，而它应该更大。
非常感谢您的帮助!
乔什

Answer 1

非连续列范围到锯齿状数组
代替...

data = shtData.Range("P2:P" & lastrow).SpecialCells(xlCellTypeVisible)

'Find the unique values
For r = 1 To UBound(data)
    dict(data(r, 1)) = Empty
Next

...使用以下...

Private Sub GetAllCampusDomains(DomainCol As Collection)
    
    '...
    
    Dim rng As Range
    Set rng = shtData.Range("P2:P" & lastrow).SpecialCells(xlCellTypeVisible)
    getNonContiguousColumn Data, rng
    
    'Find the unique values
    Dim j As Long
    For j = 0 To UBound(Data)
        For r = 1 To UBound(Data(j))
            dict(Data(j)(r, 1)) = Empty
        Next r
    Next j

    '...

End Sub

...由以下支持:

Sub getNonContiguousColumn(ByRef Data As Variant, _
                           NonContiguousColumnRange As Range, _
                           Optional FirstIndex As Long = 0)
    
    Dim j As Long
    j = FirstIndex - 1
    ReDim Data(FirstIndex To NonContiguousColumnRange.Areas.Count + j)
    
    Dim ar As Range
    Dim OneCell As Variant
    ReDim OneCell(1 To 1, 1 To 1)
    
    For Each ar In NonContiguousColumnRange.Areas
        j = j + 1
        If ar.Cells.Count > 1 Then
            Data(j) = ar.Value
        Else
            OneCell(1, 1) = ar.Value
            Data(j) = OneCell
        End If
    Next ar
    
End Sub

使用以下内容测试以前的 Sub:

Sub testGetNCC()
    
    Const rngAddr As String = "A2:A20"
    
    Dim Data As Variant
    Dim rng As Range
    Set rng = Range(rngAddr).SpecialCells(xlCellTypeVisible)
    
    getNonContiguousColumn Data, rng

    Dim j As Long, i As Long
    
    For j = 0 To UBound(Data)
        For i = 1 To UBound(Data(j))
            Debug.Print Data(j)(i, 1)
        Next i
    Next j

End Sub