根据另一列vba excel中的条件复制唯一列表

时间:2012-10-24 13:03:55

标签: excel vba

我想使用VBA提取唯一的有序列表,但要符合另一列中的条件。所以,我有两列A,B。

A    B
========
a   FALSE
b   FALSE
c   TRUE
a   TRUE
b   FALSE
c   TRUE

应该产生一个列表

C
==
a
c

我对VBA非常非常新,所以任何帮助都会受到赞赏。

哦,第二个列表将随着第一个列表的每次更改而更新,因此需要擦除以确保没有剩余,例如,如果第二个“a”设置为FALSE。

2 个答案:

答案 0 :(得分:2)

这是一种仅限公式的方法。是否实际取决于您的具体情况,但我已经使用类似于原始问题中的数据样本对其进行了测试:

  1. 在电子表格的顶部插入一个空白行作为标题行。
  2. 创建一个新的公式列,仅当列“B”为真时才会列出列“A”的元素。例如,将以下公式放在单元格D2中,然后将其复制:=IF(B2,A2,"")
  3. 现在,您可以应用上面由t.thielemans链接的第二页中描述的技术。
  4. 这种方法的一个潜在缺点是,当B列为“FALSE”时公式返回的空白单元格不会消失 - 您的过滤视图中仍然会出现空白结果。

    为方便起见,我会复制此处的参考资料: Getting unique values in Excel by using formulas only

答案 1 :(得分:0)

你怎么看待这个? 首先添加MS Scripting库。

选项明确

Sub Test()

Dim oRange As Range

Dim dict As Dictionary
Dim vArray As Variant
Dim vItem As Variant
Dim sKey As String
Dim sValue As String
Dim iCompare_TRUE As Integer

Dim lCnt As Long
Dim lCnt_Rows As Long

Set dict = New Dictionary

Set oRange = ThisWorkbook.Sheets(1).Range("A1:B6")

For lCnt = 1 To oRange.Rows.Count
    sKey = oRange(lCnt, 1)
    sValue = oRange(lCnt, 2)
    iCompare_TRUE = StrComp(sValue, "True")
    If Not dict.exists(sKey) And iCompare_TRUE = 0 Then
        With dict
            .Add sKey, sValue
        End With
    End If
Next lCnt

ReDim vArray(1 To dict.Count)
vArray = dict.Keys
lCnt_Rows = UBound(vArray) + 1

Set oRange = ThisWorkbook.Sheets(1).Range(Cells(1, 3), Cells(lCnt_Rows, 3))
oRange.Value = Application.Transpose(vArray)

End Sub