根据条件列出所有唯一值

Question

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

我有以下内容：

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

此代码列出了我需要的所有值。但是，其中一些存在多次。如何删除重复项？

Answer 1

这是另一种方法，因此您以后无需使用Scripting Dictionary删除重复项（您需要检查库中的Microsoft Scripting Runtime才能起作用）

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

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

PS：使用Like运算符时，应使用通配符*或?，而没有通配符则与使用=运算符相同。 / p>