Альтернативы использованию свойства AdvancedFilter объекта Range

Question

Я использую свойство AdvancedFilter объекта Range, чтобы скопировать уникальный набор значений в другой диапазон в моей книге.К сожалению, к ActiveSheet применен автофильтр, а инструкция AdvancedFilter удаляет автофильтр из ActiveSheet.Как вы увидите в моем коде ниже, я могу добавить автофильтр обратно в ActiveSheet, но это выглядит немного «неуклюже».Кто-нибудь может предложить альтернативное решение для кодирования?

Sub mmDropDownClasses()
'Populate the 'LU' sheet with a unique range of classes from the currently 
'active sheet

Range("LU!I2:I30").ClearContents        'Clear the range to be populated
ActiveSheet.Unprotect                   'Unprotect the active sheet

'Extract the unique values from a range on the active sheet and copy them 
'to a range on the 'LU' sheet
ActiveSheet.Range("C6:C304").AdvancedFilter Action:=xlFilterCopy, 
CopyToRange:=Range("LU!I2"), Unique:=True

'Reinstate the autofilter deleted by the advancedfilter in the previous 
'statement
ActiveSheet.Range("A5:BA5").AutoFilter
ActiveSheet.Protect AllowFiltering:=True 'Protect the active sheet

'Sort the range on the 'LU' sheet
Range("LU!I2:I30").Sort key1:=Range("LU!I2:I30"), order1:=xlAscending

End Sub 

Answer 1

Вот пример использования словаря:

Sub testit()
    Dim v
    v = UniqueListFromRange(ActiveSheet.Range("C6:C304"))
    Sheets("LU").Range("I2").Resize(UBound(v) + 1).Value = Application.Transpose(v)
End Sub

Public Function UniqueListFromRange(rgInput As Range) As Variant
    Dim d                     As Object
    Dim rgArea                As Excel.Range
    Dim dataSet
    Dim x                     As Long
    Dim y                     As Long

    Set d = CreateObject("Scripting.Dictionary")

    For Each rgArea In rgInput.Areas
        dataSet = rgArea.Value
        If IsArray(dataSet) Then
            For x = 1 To UBound(dataSet)
                For y = 1 To UBound(dataSet, 2)
                    If Len(dataSet(x, y)) <> 0 Then d(dataSet(x, y)) = Empty
                Next y
            Next x
        Else
            d(dataSet) = Empty
        End If
    Next rgArea
    UniqueListFromRange = d.keys
End Function