excel - 使用 Range 对象的 AdvancedFilter 属性的替代方法
问题描述
我正在使用 Range 对象的 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
推荐阅读
- c++ - 在没有初始值的堆中声明数组(彼此后面的变量)
- r - 在 R 中创建中断规则
- sql - 如何在组合框中包含“全选”选项?
- javascript - 使用javascript一次选择所有文本框
- python - 有没有创建数组块的相反方法?
- c# - 如何在检查器和资源管理器窗口中设置 Outlook 右侧窗格的最小宽度
- node.js - AdonisJS - 无法调用函数 csrfField
- android - 为什么我在运行我的 Android 项目时得到重复的类
- c - 读取一行并从文件中的矩阵中删除空格
- docker - 使用 Docker 在 Travis 中运行时,Zef 无法安装 JSON::Fast