根據條件從列中提取唯一值

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()使用的字符串，這是IMHO的最佳實踐。