根据条件从列中提取唯一值答案

【问题标题】：Extract unique values from column based on criteria根据条件从列中提取唯一值
【发布时间】：2019-04-15 12:29:46
【问题描述】：

我想根据标准提取唯一值。这是我目前所拥有的：

Sub test()
    Dim x As Variant
    Dim objdict As Object
    Dim lngrow As Long
    With Sheets("Sheet1")
        Set objdict = CreateObject("Scripting.Dictionary")
        x = Application.Transpose(.Range("A1", .Range("A1").End(xlDown)))
        For lngrow = 1 To UBound(x, 1)
            objdict(x(lngrow)) = 1
        Next
        .Range("C1:C" & objdict.Count) = Application.Transpose(objdict.keys)
    End With
End Sub

低于我想要达到的目标：

您可以看到值在 A 列中，条件在 B 列中，唯一值在 C 列中。谁能告诉我我需要在代码中更改什么？

【问题讨论】：

你的代码给你带来了什么问题？
哪个标准？我不明白你想要达到什么目标，或者你被困在哪里。看来您可以只使用COUNTIF 或Remove Duplicates。
我认为你不能那样做，唯一的键是强制性的。在那种情况下，你的钥匙会变成什么？似乎可以在没有字典的情况下完成，除非您使用“此键是否存在？”字典的功能并允许它实际帮助您，您可以对其进行编码，因此如果您尝试创建一个不存在的键，则不会发生任何事情，它不会被添加到字典中，这就是您希望使用字典过滤唯一性的方式。
@ashleedawg 我相信 OP 想要使用键来识别唯一的值集，这里有这样做的示例，如果键已经存在，则忽略添加，或捕获错误添加并继续。使用“键”作为真正的唯一值集，当然可以链接到任意数量的其他记录。看起来像一个“唯一键”，值 1 符合他的标准。除非有一堆价值标准，否则似乎更容易做到这一点。

标签： excel vba unique criteria

【解决方案1】：

你快到了！请参阅下面代码中的 cmets：

Option Explicit

Sub Test()
    Dim x As Variant
    Dim objDict As Object
    Dim lngRow As Long

    Set objDict = CreateObject("Scripting.Dictionary")

    With Sheet1 '<== You can directly use the (Name) property of the worksheet as seen from the VBA editor.
        x = .Range(.Cells(1, 1), .Cells(.Rows.Count, 2).End(XlDirection.xlUp)).Value

        For lngRow = 1 To UBound(x, 1)
            If x(lngRow, 2) = 1 Then '<== Example criteria: value is 1 in column B.
                objDict(x(lngRow, 1)) = 1 '<== Don't know if this is significant in your case (I typically assign True).
            End If
        Next

        .Range(.Cells(1, 3), .Cells(objDict.Count, 3)).Value = Application.Transpose(objDict.Keys)
    End With

    'Cleanup.
    Set objDict = Nothing
End Sub

请注意，我已将 Range() 中使用的字符串替换为数字索引（行、列），恕我直言，这是更好的做法。

【讨论】：