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