VBA – 当不唯一时从数组中移除两个项目

快速的问题，我一直在努力。 我有两个包含string的不同长度的数组。 我想输出一个新的数组，删除两个元素，如果检测到重复。 目前它只删除重复，但留下原来的不正确的，我想要完成。

例如

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 

编辑

另一种方式没有sorting

 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