vba 使用高级过滤器填充“列表框”（仅限唯一值）
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/18323987/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Populate "List Box" with Advanced Filter (Unique Values Only)
提问by Greg Ehrsam
Excel 2007
Excel 2007
I have about 1000 rows in column A of which 250 are unique. I need the 250 unique rows to show up in a form where the user selects multiple items. I'be been using macro recorder with the advanced filter and can't get the list to populate. I'm trying to assign the list to a Range variable.
我在 A 列中有大约 1000 行，其中 250 行是唯一的。我需要 250 个唯一行以用户选择多个项目的形式显示。我一直在使用带有高级过滤器的宏记录器，但无法填充列表。我正在尝试将列表分配给 Range 变量。
Public Sub UniqueCMFundList()
Dim CMFundList As Range
Dim RangeVar1 As Range
Dim RangeVar2 As Range
Sheets("HiddenDataList").Activate
Range("A2").Select
Set RangeVar1 = Range(Selection, Selection.End(xlDown)).Select
Set CMFundList = RangeVar1.AdvancedFilter(xlFilterInPlace, , , True)
'This is what I get with macro recorder:
'Range("A1:A1089").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
' Range("A1:A1089"), Unique:=True
Debug.Print CMFundList.Value
End Sub
回答by tigeravatar
Here's one way:
这是一种方法：
Private Sub UserForm_Initialize()
Dim arrUnqItems As Variant
With Sheets("HiddenDataList")
.Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).AdvancedFilter xlFilterCopy, , .Cells(1, .Columns.Count), True
arrUnqItems = Application.Transpose(.Range(.Cells(2, .Columns.Count), .Cells(.Rows.Count, .Columns.Count).End(xlUp)).Value)
.Columns(.Columns.Count).Clear
End With
Me.ListBox1.Clear
Me.ListBox1.List = arrUnqItems
Erase arrUnqItems
End Sub
回答by Cor_Blimey
You can also do this using a Collection object. For large worksheets it should be a lot faster than filtering, particularly if there are formulae involved. Note that if you want a collection returned then just change the last bit that converts the collection to an array (the array is for your convenience for the list box)
您也可以使用 Collection 对象执行此操作。对于大型工作表，它应该比过滤快得多，特别是如果涉及公式。请注意，如果您想要返回一个集合，那么只需更改将集合转换为数组的最后一位（该数组是为了方便列表框）
I use a slightly more nuanced variant of the below adapted for array and range arguments and switches to ignore stuff all the time and it is pretty darn quick.
我使用了下面的一个稍微更细微的变体，适用于数组和范围参数，并切换到一直忽略的东西，而且速度非常快。
'Just use it like:
Me.ListBox1.List = GetUniqueItems(Range("A1:A100"))
Public Function GetUniqueItems(rng As Range) As Variant()
Dim c As Collection
Dim arr, ele
Dim i As Long
Dim area As Range
Set c = New Collection
For Each area In rng.Areas
arr = area.Value
On Error Resume Next
If IsArray(arr) Then
For Each ele In arr
c.Add ele, VarType(ele) & "|" & CStr(ele)
Next ele
Else
c.Add arr, VarType(arr) & "|" & CStr(arr)
End If
On Error GoTo 0
Next area
If c.Count > 0 Then
ReDim arr(0 To c.Count - 1)
For i = 0 To UBound(arr)
arr(i) = c(i + 1)
Next i
GetUniqueItems = arr
End If
End Function
Alternatively, an advanced filter (in place - there is no need for the overhead of copying the data elsewhere):
或者，一个高级过滤器（到位 - 不需要在别处复制数据的开销）：
Dim rng As Range
Dim uniques
Set rng = Range("A1:A1001")
rng.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
uniques = Application.WorksheetFunction.Transpose(Intersect(rng, rng.Offset(1, 0)).SpecialCells(xlCellTypeVisible).Value)
rng.Show 'not necessary if you are only using the worksheet as hidden etc but this removes the filter
Me.Listbox1.List = uniques
