从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

结果应与此类似：

< a href =https://i.stack.imgur.com/VTopL.png =nofollow noreferrer>

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