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

Question

我想根据条件提取唯一值。这是我到目前为止的内容：

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列中。谁能告诉我我需要在代码中进行哪些更改？

Answer 1

您快到了！请参见下面的代码中的注释：

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()中使用的字符串替换为数字索引（行，列），恕我直言是一种更好的做法。