Question

Excel 2007

我在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

Answer 1

这是一种方式：

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

Answer 2

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

我使用了一个稍微复杂的下面的数组和范围参数变换，并且开关一直忽略这些东西而且非常快。

'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

或者，一个高级过滤器（就地 - 不需要在其他地方复制数据的开销）：

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

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

2 个答案: