Question

我正在使用excel工作簿，我希望在列中找到所有唯一值。

我的代码通过循环遍历所有行以及每行循环查看到目前为止看到的值集合并检查我之前是否已经看过它。

它的工作原理如下。

Function getUnique(Optional col As Integer) As Collection
    If col = 0 Then col = 2
    Dim values As Collection
    Dim value As Variant
    Dim i As Integer
    Dim toAdd As Boolean
    
    i = 3 'first row with data
    Set values = New Collection
    
    Do While Cells(i, col) <> ""
        toAdd = True
        For Each value In values
            If Cells(i, col).value = value Then toAdd = False
        Next value
        If toAdd Then values.Add (Cells(i, col).value)
        i = i + 1
    Loop
    
    Set getUnique = values
        
End Function

但是，Excel AutoFilter能够更快地找到这些值。有没有办法过滤然后读取唯一值？

我已尝试使用AutoFilter.Filters对象，但所有.ItemX.Criteria1值都有“应用程序定义或对象定义的错误”（使用ActiveSheet.AutoFilter.Filters上的监视找到）。

Answer 1

这并不是你所描述的那样，我认为它处理效率较低，因为它会针对每个值检查每个单元格。

我认为这可能是低效的，因为随着values集合的长度增加，第二个循环将需要更长的时间来处理。

如果您提前退出嵌套的For，可以获得一些改进：

    Do While Cells(i, col) <> ""
        For Each value In values
            If Cells(i, col).value = value Then 
                toAdd = False
            Else:
                values.Add (Cells(i, col).value) 
                Exit For  '### If the value is found, there's no use in checking the rest of the values!
            End If
        Next value
        i = i + 1
    Loop

但我认为词典可能会提升你的表现。这样，我们不需要遍历集合，我们只使用字典的.Exists方法。如果它不存在，我们添加到集合中，如果它存在，我们不会。然后该函数仍然返回唯一的集合。

Function getUnique(Optional col As Integer) As Collection
    If col = 0 Then col = 2
    Dim values As Object
    Dim value As Variant
    Dim i As Integer
    Dim toAdd As Boolean
    Dim ret as New Collection

    i = 3 'first row with data
    Set values = CreateObject("Scripting.Dictionary")

    With Cells(i, col)
    Do While .Value <> ""
        If Not values.Exists(.Value) 
            values(.Value) = 1
            ret.Add(.Value)   '## Add the item to your collection
        Else
            '## Count the occurences, in case you need to use this later
            values(.Value) = values(.Value) + 1

        End If
        i = i + 1
    Loop

    Set getUnique = ret

End Function

Answer 2

AdvancedFilter方法可能会派上用场，生成更清晰，更易于维护的代码。只要您从另一个VBA模块调用此函数而不是从单元格调用此函数，这将起作用。

Function getUnique(Optional col As Integer) As Collection

    If col = 0 Then col = 2

    Dim values As Collection
    Dim value As Variant
    Dim i As Integer

    i = 3 'first row with data

    Range(Cells(i, col), Cells(Rows.Count, col).End(xlUp)).AdvancedFilter xlFilterCopy, CopyToRange:=Cells(1, Columns.Count)

    Set values = New Collection

    Dim cel As Range
    For Each cel In Range(Cells(1, Columns.Count), Cells(1, Columns.Count).End(xlDown))
        values.Add cel.value
    Next

    Range(Cells(2, Columns.Count), Cells(1, Columns.Count).End(xlDown)).Clear

    Set getUnique = values

End Function

使用此子测试：

Sub Test()

Dim c As Collection
Set c = getUnique(4)

For i = 1 To c.Count
    Debug.Print c.Item(i)
Next


End Sub

使用VBA读取AutoFilter标准

2 个答案: