Arrays 根据标准列出所有唯一值

我需要在其他列中列出所有具有特定条件的值，如图所示

我有以下资料：

Sub arytest()

Dim ary()
Dim note2()
Dim lastrow As Long
Dim i As Long
Dim k As Long
Dim eleAry, x

'Number of rows in my data file
lastrow = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row

'The maximum length of my array
ReDim ary(1 To lastrow)

k = 1
For i = 1 To lastrow
    If Cells(i, 2) Like "*Note 2*" _   ' Criterias that needs to be fullfilled
    And Cells(i, 1) Like "Actuals" _
    And Cells(i, 4) Like "Digitale Brugere" Then
        ary(k) = Cells(i, 3)
        k = k + 1
    End If
Next i

End Sub

---

这段代码列出了我需要的所有值。然而，其中一些人多次出现。如何删除重复项？

这里有另一种方法，因此您以后无需使用

脚本字典

删除重复项（您需要检查库中的

Microsoft脚本运行时

，以使其正常工作）

我还看到一些未在代码中使用的变量，或者至少是您发布的变量

---

PS：当使用

Like

运算符时，您应该使用通配符

*

或

？

，没有通配符与使用

=

运算符相同。

您是否尝试过基于1列（具有重复值的列）删除重复项如果有更多具有不同数据的列，则删除重复项不起作用，但是如果你在你想检查的专栏上做了标记，效果很好。非常感谢您的投入！所以这个makro是我需要做30次的事情。每个区域一个。这里的问题是我需要恢复原始数据。所以我需要在一个数组中完成它，这样行吗？我给你提供了另一种使用字典的方法。s根据问题指南，请不要发布代码、数据、错误消息等的图像-在问题中复制或键入文本。请保留图像用于图表或演示渲染错误，这是无法通过文本准确描述的。很高兴提供帮助。别忘了把它标记为一个答案，这样别人就能找到它。

Sub arytest()

    Dim ary()
    Dim note2() 'unsued
    Dim lastrow As Long
    Dim i As Long
    Dim k As Long
    Dim eleAry, x 'unused
    Dim DictDuplicates As Scripting.Dictionary

    Set DictDuplicates = New Scripting.Dictionary
    'Number of rows in my data file
    lastrow = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row

    'The maximum length of my array
    ReDim ary(1 To lastrow)

    k = 1
    For i = 1 To lastrow
        ' Criterias that needs to be fullfilled
        If Cells(i, 2) Like "*Note 2*" _
        And Cells(i, 1) Like "Actuals" _
        And Cells(i, 4) Like "Digitale Brugere" Then
            If Not DictDuplicates.Exists(Cells(i, 3).Value) Then 'check if the value is already on the array
                ary(k) = Cells(i, 3)
                DictDuplicates.Add Cells(i, 3).Value, i 'if it does not exists, add it to the dictionary
            End If
            k = k + 1
        End If
    Next i

End Sub