Excel VBA获取唯一值

Question

我有2个数组：DirCurrentArray和DirHistoryArray，但我似乎无法从DirHistoryArray获得DirCurrentArray中唯一的值

Dim DirCurrentArray As String
Dim DirHistoryArray As Variant

'Gets Filenames into Array
Do While xFile <> ""
    DirCurrentArray(fileCount) = xFile
    xFile = Dir$
    fileCount = fileCount + 1
Loop

For Each i In DirCurrentArray
        For Each j In DirHistoryArray
            If i = j Then
                finalCount = finalCount + 1
                DirFinalArray(finalCount) = i
            End If
        Next j
    Next i

我想要的结果是DirCurrentyArray，其中删除了在DirHistoryArray中找到的所有值

Answer 1

此代码的有效性在某种程度上取决于您要比较的数据的性质，因为基于文本的值可能会对部分匹配（例如通配符搜索）产生误报。甚至 1 也会在 11 或 15 中找到过滤器匹配项，依此类推。我使用工作表的Match函数添加了“整个单词”匹配项作为替代。

Option Explicit

Sub ytrte()
    Dim DirCurrentArray As Variant, DirHistoryArray As Variant
    Dim i As Long, k As Variant, DirNewArray As Variant

    DirCurrentArray = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 0)
    DirHistoryArray = Array(3, 4, 5, 6, 7, 8, 11)

    ReDim DirNewArray(0)
    i = 0

    ' 'wildcard' matching
    For Each k In DirCurrentArray
        If UBound(Filter(DirHistoryArray, k, True, vbBinaryCompare)) < 0 Then
            ReDim Preserve DirNewArray(i)
            DirNewArray(i) = k
            i = i + 1
        End If
    Next k

    If Not IsEmpty(DirNewArray(LBound(DirNewArray))) Then
        For i = LBound(DirNewArray) To UBound(DirNewArray)
            Debug.Print DirNewArray(i)
        Next i
    End If

'contents of DirNewArray
 2 
 9 
 0 

    ReDim DirNewArray(0)
    i = 0

    ' 'whole word' matching
    For Each k In DirCurrentArray
        If IsError(Application.Match(k, DirHistoryArray, 0)) Then
            ReDim Preserve DirNewArray(i)
            DirNewArray(i) = k
            i = i + 1
        End If
    Next k

    If Not IsEmpty(DirNewArray(LBound(DirNewArray))) Then
        For i = LBound(DirNewArray) To UBound(DirNewArray)
            Debug.Print DirNewArray(i)
        Next i
    End If
'contents of DirNewArray
 1 
 2 
 9 
 0 

End Sub

调整循环以填充文件名。

Dim DirCurrentArray() As Variant
Dim fileCount As long
...
'Gets Filenames into Array
fileCount = 0
Do While xFile <> ""
    redim preserve DirCurrentArray(fileCount)
    DirCurrentArray(fileCount) = xFile
    fileCount = fileCount + 1
    xFile = Dir$
Loop

Answer 2

我认为您可以根据需要使用Dictionary来存储，比较和检索数组项。

您可以尝试这样的事情...

Dim dict
Set dict = CreateObject("Scripting.Dictionary")

'Load DirCurrentArray into dictionary
For i = LBound(DirCurrentArray) To UBound(DirCurrentArray)
    dict.Item(DirCurrentArray(i)) = ""
Next i

'Remove from dictionary if DirHistoryArray elements are found in dictionary
For i = LBound(DirHistoryArray) To UBound(DirHistoryArray)
    If dict.exists(DirHistoryArray(i)) Then dict.Remove (DirHistoryArray(i))
Next i

'If dictionary is not empty then populate the DirCurrentArray with dictionary keys
If dict.Count Then
    DirCurrentArray = dict.keys
    MsgBox Join(DirCurrentArray, ", ")
Else
    MsgBox "DirCurrentArray is empty."
End If

Answer 3

构建集合以查找唯一值。我的代码首先将DirCurrentArray中的所有值添加到ArrayList，然后从ArrayList中删除DirHistoryArray中的所有值。最后，它将ArrayList中的值分配给DirFinalArray。

Sub GetUniqueValuesFrom2Arrays()
    Dim DirCurrentArray As Variant, DirHistoryArray As Variant, DirFinalArray, Key As Variant
    Dim list As Object
    Set list = CreateObject("System.Collections.ArrayList")

    Dim i As Long, k As Variant, DirNewArray As Variant

    DirCurrentArray = Array("A", "B", "C", 1, 2, 3, 4, 5)
    DirHistoryArray = Array("C", "D", 1, 3, 5)

    For Each Key In DirCurrentArray
        list.Add Key
    Next

    For Each Key In DirHistoryArray
        If list.Contains(Key) Then list.Remove Key
    Next

    DirFinalArray = list.ToArray()

    MsgBox "DirCurrentArray: " & Join(DirCurrentArray, ",") & vbNewLine & _
        "DirCurrentArray: " & Join(DirHistoryArray, ",") & vbNewLine & _
        "DirFinalArray: " & Join(DirFinalArray, ",")

End Sub

Answer 4

检查一下

Option Base 1
Sub test()

    Dim DirCurrentArray(5) As Integer
    Dim DirHistoryArray(5) As Integer
    Dim DirFinalArray() As Integer


    DirCurrentArray(1) = 1
    DirCurrentArray(2) = 4
    DirCurrentArray(3) = 5
    DirCurrentArray(4) = 1
    DirCurrentArray(5) = 7


    DirHistoryArray(1) = 1
    DirHistoryArray(2) = 2
    DirHistoryArray(3) = 1
    DirHistoryArray(4) = 4
    DirHistoryArray(5) = 1

    Dim blnExist As Boolean

    For Each i In DirCurrentArray
        For Each j In DirHistoryArray

            If i = j Then
                blnExist = True
                Exit For
            End If

        Next

        If blnExist = False Then
            finalcount = finalcount + 1
            ReDim Preserve DirFinalArray(finalcount)
            DirFinalArray(finalcount) = i
        End If

        blnExist = False
    Next


End Sub