Vba “填充”；列表框“；使用高级过滤器（仅限唯一值）

Excel 2007

我在A列中有大约1000行，其中250行是唯一的。我需要250个唯一的行以用户选择多个项目的形式显示。我一直在使用带有高级过滤器的宏记录器，无法获取要填充的列表。我正在尝试将列表分配给一个范围变量

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

这里有一个方法：

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

---

也可以使用集合对象来执行此操作。对于大型工作表，它应该比过滤快得多，特别是在涉及公式的情况下。请注意，如果希望返回集合，则只需更改将集合转换为数组的最后一位（该数组是为了方便您查看列表框）

我使用了下面的一个稍微细微的变体，它适用于数组和范围参数以及开关，可以一直忽略这些东西，而且速度非常快

'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

或者，一个高级过滤器（就地-无需在别处复制数据的开销）：

---

你收到错误信息了吗？如果是这样的话，它是什么，它指的是哪条线。嘿，我以前从来没有注意到Transpose将列数组更改为向量。有用：-）谢谢。我是VB新手。我没有收到任何错误，但是列表框中也没有显示任何内容？我的用户表单（名称）是“ERSHOFFINGFILE”，而我的列表框（名称）是“ListBox\u SelectCMFund”，因此我将“UserForm\u Initialize（）”替换为“ListBox\u SelectCMFund”，将“ListBox1”替换为“ListBox\u SelectCMFund”。如果更改了子名称，则需要手动运行子名称。我建议将子名称保留为“UserForm\u Initialize”。这是第一次加载userform时将运行的关键字子名称。因此，基本上，它将填充open上的列表框。难以准确理解此处发生的情况：。范围("A1…：复制唯一值arrUnqItems=：将值从columnar转换为array.Columns….清除：清除列如何将xlFilterCopy的结果传递给Application.Transpose？为什么要清除列？我在示例工作簿中注释掉了该行，但什么都看不见。我是VB新手。感谢您的帮助。我我无法在我的[ListBox（Name）ListBox\u SelectCMFund]中显示任何内容，它是[UserForm（Name）ErrsofuringFile]的一部分。我尝试了代码并尝试更新RowSource属性，但它只是空的。

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