VBA - 当不唯一时从数组中删除这两个项目

Question

我一直在努力解决的快速问题。我有2个不同长度的数组，包含字符串。 我想输出一个新数组，如果检测到重复，则删除元素。目前它只删除了重复项，但保留了原文，这对我想要完成的内容是不正确的。

E.g。

input = array ("cat","dog","mouse","cat")  
expected output =  array ("dog","mouse")  
actual output = array ("cat","dog","mouse")  

代码如下：

Sub removeDuplicates(CombinedArray)
Dim myCol As Collection
Dim idx As Long
Set myCol = New Collection

On Error Resume Next

For idx = LBound(CombinedArray) To UBound(CombinedArray)
    myCol.Add 0, CStr(CombinedArray(idx))
    If Err Then
        CombinedArray(idx) = Empty
        dups = dups + 1
        Err.Clear
    ElseIf dups Then
        CombinedArray(idx - dups) = CombinedArray(idx)
        CombinedArray(idx) = Empty
    End If
Next

For idx = LBound(CombinedArray) To UBound(CombinedArray)
    Debug.Print CombinedArray(idx)
Next
removeBlanks (CombinedArray)
End Sub

提前感谢您的所有帮助和支持。

Answer 1

使用Scripting.Dictionary怎么样？像这样：

Function RemoveDuplicates(ia() As Variant)

Dim c As Object
Set c = CreateObject("Scripting.Dictionary")
Dim v As Variant
For Each v In ia
    If c.Exists(v) Then
        c(v) = c(v) + 1
    Else
        c.Add v, 1
    End If
Next

Dim out() As Variant
Dim nOut As Integer
nOut = 0

For Each v In ia
    If c(v) = 1 Then
        ReDim Preserve out(nOut) 'you will have to increment nOut first, if you have 1-based arrays
        out(nOut) = v
        nOut = nOut + 1
    End If
Next

RemoveDuplicates = out

End Function

Answer 2

这是一个简单的例子。如果您有任何错误，请告诉我。

Sub Sample()
    Dim inputAr(5) As String, outputAr() As String, temp As String
    Dim n As Long, i As Long

    inputAr(0) = "cat": inputAr(1) = "Hen": inputAr(2) = "mouse"
    inputAr(3) = "cat": inputAr(4) = "dog": inputAr(5) = "Hen"

    BubbleSort inputAr

    For i = 1 To UBound(inputAr)
        If inputAr(i) = inputAr(i - 1) Or inputAr(i) = temp Then
            inputAr(i - 1) = "": temp = inputAr(i): inputAr(i) = ""
        End If
    Next i

    n = 0
    For i = 1 To UBound(inputAr)
        If inputAr(i) <> "" Then
            n = n + 1
            ReDim Preserve outputAr(n)
            outputAr(n) = inputAr(i)
        End If
    Next i

    For i = 1 To UBound(outputAr)
        Debug.Print outputAr(i)
    Next i
End Sub

Sub BubbleSort(arr)
    Dim value As Variant
    Dim i As Long, a As Long, b As Long, c As Long

    a = LBound(arr): b = UBound(arr)

    Do
        c = b - 1
        b = 0
        For i = a To c
            value = arr(i)
            If (value > arr(i + 1)) Xor False Then
                arr(i) = arr(i + 1)
                arr(i + 1) = value
                b = i
            End If
        Next
    Loop While b
End Sub

修改

另一种没有排序的方法

Sub Sample()
    Dim inputAr(5) As String, outputAr() As String
    Dim n As Long, i As Long, j As Long
    Dim RemOrg As Boolean

    inputAr(0) = "cat": inputAr(1) = "Hen": inputAr(2) = "mouse"
    inputAr(3) = "cat": inputAr(4) = "dog": inputAr(5) = "Hen"

    For i = 0 To UBound(inputAr)
        For j = 1 To UBound(inputAr)
            If inputAr(i) = inputAr(j) Then
                If i <> j Then
                    inputAr(j) = "": RemOrg = True
                End If
            End If
        Next
        If RemOrg = True Then
            inputAr(i) = ""
            RemOrg = False
        End If
    Next i

    n = 0
    For i = 0 To UBound(inputAr)
        If inputAr(i) <> "" Then
            n = n + 1
            ReDim Preserve outputAr(n)
            outputAr(n) = inputAr(i)
        End If
    Next i

    For i = 1 To UBound(outputAr)
        Debug.Print outputAr(i)
    Next i
End Sub