时间戳

首页 > 解决方案 > 根据条件从列中提取唯一值

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

问题描述

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

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

标签： excelvbauniquecriteria

解决方案

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

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

推荐阅读