1

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
4

2 回答 2

2

这是一种方法：

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
于 2013-08-19T22:55:35.287 回答
0

您也可以使用 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
于 2013-08-20T00:02:56.103 回答