从VBA中的filter中提取唯一值的集合

我有一个文件，其行数可以跨越8列数以万计。 一个特定的列包含周末date。 我必须计算在这个文件中出现的周末数。

有没有一种方法来提取数据，如下图所示？

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

请帮忙。

提前致谢！

Answer 1

下面将从列A（25K值）中取出一系列三个随机大写字母，并将它们作为唯一键（13,382个值）放到一个字典中，然后将它们转储回同一工作表中的C列，然后对它们进行sorting。 往返需要约0.072秒。

以下代码要求您进入VBE的工具►参考并添加Microsoft脚本运行时。 这包含Scripting.Dictionary的库定义。 但是，如果您使用CreateObject（“Scripting.Dictionary”），则不需要库引用。

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 

结果应该是这样的：

Answer 2

要像filter对话框那样从列中获取唯一值，可以使用Range.RemoveDuplicates方法。

例：

 ' Index of Column which contains the weekend date Const weekendDateColumn As Integer = 2 Sub GetUniques() ' Create copy of active sheet with data so original data remains unchanged ActiveSheet.Copy After:=ActiveSheet ' Call Range.RemoveDuplicates method which removes duplicates in ' data besed on values in column 'weekendDateColumn' Dim data As Range Set data = ActiveSheet.Range("A1").CurrentRegion data.RemoveDuplicates Columns:=Array(weekendDateColumn), Header:=xlYes ' Get unique values into array Dim uniques As Variant uniques = data.CurrentRegion.Columns(weekendDateColumn).Value ' Clear data resize it to size of uniques and paste the uniques there data.Clear data.Resize(UBound(uniques, 1), 1).Value = uniques End Sub 

Answer 3

select单元格范围，或确保活动单元格在表格中。

在“数据”选项卡的“sorting和筛选”组中，单击“高级”。

“数据”选项卡上的“sorting和筛选”组

在“高级筛选器”对话框中，执行以下操作之一：

要就地过滤单元格或表格的范围，请单击“就地过滤”列表。

要将filter的结果复制到其他位置，请执行以下操作：

点击复制到另一个位置。

在复制到框中，input单元格引用。

或者，单击“折叠对话框button”图像以暂时隐藏对话框，在工作表上select一个单元格，然后按“扩展对话框button”图像。

select“仅限唯一logging”checkbox，然后单击“确定”。

所选范围中的唯一值将被复制到新位置。

Answer 4

您可以使用ADODB连接到相应的工作表，然后针对工作表发出一条SQL语句：

 Dim datasourcePath As String datasourcePath = "C:\path\to\excel\file.xlsx" Dim conn As New Connection, rs As Recordset With conn .Provider = "Microsoft.ACE.OLEDB.12.0" .ConnectionString = "Data Source=""" & datasourcePath & """;" & _ "Extended Properties=""Excel 12.0;HDR=No;""" 'If you're running a version of Excel earlier than 2007, the connection string should look like this: '.ConnectionString = "Data Source=""" & datasourcePath & """;" & _ ' "Extended Properties=""Excel 8.0;HDR=No;""" .Open Set rs = .Execute("SELECT DISTINCT F1 FROM [Sheet1$]") 'F1 is an autogenerated field name Do Until rs.EOF Debug.Print rs("F1") Loop End With