从 VBA 中的过滤器中提取唯一值的集合 [英] Extracting the collection of unique values from a filter in VBA

问题描述

我有一个文件，该文件的行数在 8 列中扩展到数万行.一个特定的列包含周末日期.我必须计算这个文件中存在的周末数.

I have a file which has rows extending to tens of thousands across 8 columns. One particular column contains the weekend date. I have to count the number of weekends present in this file.

有没有办法提取如下图所示的数据?

Is there a way to extract the data as shown in the image below?

如果我们能够提取并得到这个集合的计数，那么问题就解决了.

If we can extract and get the count of this collection, then the problem is solved.

请帮忙.

提前致谢！

推荐答案

以下将从 A 列(25K 个值)中取出一系列随机的三个大写字母，将它们作为唯一键(13,382 个值)放入字典中并在对它们进行排序之前将它们转储回同一工作表上的 C 列.往返大约需要 0.072 秒.

The following will take a series of three randomized upper-case letters from column A (25K values), put them into a dictionary as unique keys (13,382 values) and dump them back into column C on the same worksheet before sorting them. The round trip takes ~0.072 seconds.

以下代码要求您进入 VBE 的工具 ► 参考并添加 Microsoft Scripting Runtime.这保存了 Scripting.Dictionary 的库定义.但是，如果使用 CreateObject("Scripting.Dictionary")，则不需要库引用.

The following code requires that you go into the VBE's Tools ► References and add Microsoft Scripting Runtime. This holds the library definitions for a Scripting.Dictionary. However, if you use CreateObject("Scripting.Dictionary"), you do not require the library reference.

Sub buildFilterList()
    Dim dMUSKMELONs As Object    'New Scripting.Dictionary
    Dim v As Long, w As Long, vTMPs As Variant

    Debug.Print Timer
    Set dMUSKMELONs = CreateObject("Scripting.Dictionary")

    With Worksheets("Sheet2")   '<-set this worksheet reference properly!
        vTMPs = .Range(.Cells(2, "A"), .Cells(Rows.Count, "A").End(xlUp)).Value2
        For v = LBound(vTMPs, 1) To UBound(vTMPs, 1)
            If Not dMUSKMELONs.Exists(vTMPs(v, 1)) Then _
                dMUSKMELONs.Add key:=vTMPs(v, 1), Item:=vbNullString
        Next v
        With .Cells(2, "C").Resize(dMUSKMELONs.Count, 1)
            .Value = Application.Transpose(dMUSKMELONs.Keys)
            .Cells.Sort Key1:=.Columns(1), Order1:=xlAscending, _
                        Orientation:=xlTopToBottom, Header:=xlNo
        End With
        .Cells(2, "D") = dMUSKMELONs.Count
    End With

    dMUSKMELONs.RemoveAll
    Set dMUSKMELONs = Nothing

    Debug.Print Timer

End Sub

结果应该类似于:

这篇关于从 VBA 中的过滤器中提取唯一值的集合的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！