[英]Using VBA to Read AutoFilter Criteria
I am working with an excel workbook where I want to find all unique values in a column. 我正在使用excel工作簿,我想在其中查找列中的所有唯一值。
I have code that works by looping through all the rows and for each row looping through a collection of values seen so far and checking if I've seen it before. 我的代码可以通过遍历所有行,并为每一行遍历到目前为止看到的值的集合并检查是否曾经见过的代码来工作。
It works like this. 它是这样的。
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
However, Excel AutoFilter is able to find these values much faster. 但是,Excel自动筛选器能够更快地找到这些值。 Is there a way to filter and then read the unique values? 有没有办法过滤然后读取唯一值?
I've tried using the AutoFilter.Filters object but all of the .ItemX.Criteria1 values have a "Application-defined or object-defined error" (found using a watch on ActiveSheet.AutoFilter.Filters). 我试过使用AutoFilter.Filters对象,但是所有.ItemX.Criteria1值都有一个“应用程序定义或对象定义的错误”(使用ActiveSheet.AutoFilter.Filters上的监视表可以找到)。
This isn't quite doing what you describe, I think it's processing it less-efficiently because it's checking every cell against every value. 这并没有完全按照您的描述进行,我认为它的处理效率较低,因为它会针对每个值检查每个单元格。
I think this is probably inefficient, because as the values
collection grows in length, the second loop will take longer to process. 我认为这可能效率不高,因为随着values
集合的长度增加,第二个循环将花费更长的时间来处理。
You could get some improvement if you exit your nested For
early: 如果您退出嵌套你可以得到一定的改善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
But I think a Dictionary may give you performance improvement. 但是我认为字典可以提高性能。 This way, we don't need to loop over the collection, we just make use of the dictionary's .Exists
method. 这样,我们就不需要遍历集合,只需要使用字典的.Exists
方法即可。 If it doesn't exist, we add to the collection, if it does, we don't. 如果不存在,则添加到集合中,如果不存在,则不添加。 Then the function still returns the collection of uniques. 然后,该函数仍返回唯一集。
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
The AdvancedFilter
method may come in handy here and produce cleaner, easier to maintain code. AdvancedFilter
方法在这里可能会派上用场,并产生更干净,更易于维护的代码。 This will work so long as you are calling this Function from another VBA module and not from a cell. 只要您是从另一个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
Tested with this sub: 用这个子测试:
Sub Test()
Dim c As Collection
Set c = getUnique(4)
For i = 1 To c.Count
Debug.Print c.Item(i)
Next
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.