Excel 使用范围对象的AdvancedFilter属性的替代方法

我正在使用范围对象的AdvancedFilter属性将一组唯一的值复制到工作簿中的另一个范围。不幸的是，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 

---

以下是使用字典的示例：

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

子测试（）
暗v
v=UniqueListFromRange（ActiveSheet.Range（“C6:C304”））
图纸（“LU”）。范围（“I2”）。调整大小（UBound（v）+1）。值=应用程序。转置（v）
端接头
公共函数UniqueListFromRange（rgInput作为范围）作为变量
将d作为对象
以Excel.Range显示的Dim rgArea
Dim数据集
暗x等长
长得一样暗
Set d=CreateObject（“Scripting.Dictionary”）
对于rgInput.区域内的每个RGA区域
数据集=rgrea.Value
如果是IsArray（数据集），则
对于x=1到UBound（数据集）
对于y=1到UBound（数据集，2）
如果Len（数据集（x，y））为0，则d（数据集（x，y））=空
下一个y
下一个x
其他的
d（数据集）=空
如果结束
下一个区域
UniqueListFromRange=d键
端函数

它能工作吗？我想您可以先将原始数据复制到一个新的、临时的空白表中，然后在那里进行工作。您可以使用字典创建一个唯一的值列表。谢谢Andy G。我相信这是解决问题的另一种方法。@Rory谢谢您的建议。我以前没有使用过Dictionary对象，所以我会查找它并进行实验。我今天将它添加到我的代码中，它完美地完成了工作！非常感谢。现在我正试图了解它是如何工作的。我认为最让我困惑的是，我看不到将值写入Dictionary对象的位置以及“Len”语句迭代实现了什么。道歉，如果这是一个基本的VBA课程！！如果您不想解释，请接受我对解决方案的感谢。使用

d（数据集（x，y））

将使用单元格值作为键向字典添加新项，或更新现有项。这样，您就可以得到一个唯一的列表

Len

很简单，因为添加空白条目没有多大意义。