Question

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

有没有办法提取数据，如下图所示？

如果我们可以提取并获取此集合的计数，那么问题就解决了。

请帮忙。

提前致谢！

Answer 1

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

以下代码要求您进入VBE的工具►参考并添加Microsoft Scripting Runtime。它保存了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

要从过滤器对话框中获取列中的唯一值，可以使用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

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

在数据标签上，在排序＆amp;过滤组，单击“高级”。

排序＆amp; “数据”选项卡上的过滤器组

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

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

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

点击复制到其他位置。

在“复制到”框中，输入单元格引用。

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

选中“仅限唯一记录”复选框，然后单击“确定”。

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

Answer 4

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

Dim datasourcePath As String
datasourcePath = "C:\path\to\excel\file.xlsx"

Dim connectionString As String
connectionString = _
    "Provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source=""" & datasourcePath & """;" & _
    "Extended Properties=""Excel 12.0;HDR=No""

Dim sql As String
sql = "SELECT DISTINCT F1 FROM [Sheet1$]" 'F1 is an autogenerated field name

Dim rs As New ADODB.Recordset
rs.Open sql, connectionString

Do Until rs.EOF
    Debug.Print rs("F1")
Loop

Answer 5

Yes, Data tab >> remove duplicates

从VBA中的过滤器中提取唯一值的集合

5 个答案: