VBA删除包含相同值的数组中的重复值

有一种方法可以删除VBA中的所有重复项， 也是第一个值 。 只保留不重复的值

例：

Array_1 ['pedro','maria','jose','jesus','pepe','pepe','jose'] 

结果：

 Array_1 ['pedro','maria','jesus'] 

Answer 1

试试这个代码：

 Sub Remove_All_Duplicated() Dim Array_1 Array_1 = Array("pedro", "maria", "jose", "jesus", "pepe", "pepe", "jose") Dim Array_2() Dim eleArr_1, x x = 0 For Each eleArr_1 In Array_1 If UBound(Filter(Array_1, eleArr_1)) = 0 Then ReDim Preserve Array_2(x) Array_2(x) = eleArr_1 x = x + 1 End If Next End Sub 

作为Filterfunction的附加解决scheme不关心“完全匹配”。 这个新的需要参考VBA项目中的Microsoft Scripting Runtime。

 Sub alternative() Dim Array_1 Array_1 = Array("pedro", "pedro maria", "maria", "jose", "jesus", "pepe", "pepe", "jose") Dim Array_2() Dim Array_toRemove() Dim dic As New Scripting.Dictionary Dim arrItem, x As Long For Each arrItem In Array_1 If Not dic.Exists(arrItem) Then dic.Add arrItem, arrItem Else ReDim Preserve Array_toRemove(x) Array_toRemove(x) = dic.Item(arrItem) x = x + 1 End If Next For Each arrItem In Array_toRemove dic.Remove (arrItem) Next arrItem Array_2 = dic.Keys 'quic tests to remove when unnecessary Debug.Print UBound(Array_2), UBound(Array_toRemove) Debug.Print Join(Array_2, "/") End Sub 

Answer 2

这是另一个版本：

 Public Sub ShortVersion() Dim varInput: varInput = Array("pedro", "pedro maria", "maria", "jose", "jesus", "pepe", "pepe", "jose") Dim colOutput As Collection: Set colOutput = New Collection Dim i As Long: For i = LBound(varInput) To UBound(varInput) If UBound(Split(Chr(1) & Join(varInput, Chr(1) & Chr(1)) & Chr(1), Chr(1) & varInput(i) & Chr(1))) = 1 Then colOutput.Add varInput(i) End If Next i End Sub 

优点：

• 较短的代码
• 决策标准与循环的后续迭代无关，因此，如果将其构build在algorithm中，则可以继续执行第一个元素，而不必等待稍后的决策
• 不依赖MS脚本运行时

缺点：

• 对较大的arrays效率较低
• 输出一个Collection而不是一个数组（需要一个循环来转换成一个数组，如果需要的话）
• 假设数组仅包含文本，并且ASCII 1（SOH）不会出现在任何地方（但这很可能）

Answer 3

如何使用Filter（）VBA函数创build新的A_temp1（）而不重复：

  Dim A_temp1() As String Dim NUMERO1 As Long Dim NUMERO2 As Long Dim DATO1 As Variant NUMERO1 = 0 For Each DATO1 In Array_1 If UBound(Filter(Array_1, DATO1)) > 0 Then Array_1(NUMERO1) = vbNullString End If NUMERO1 = NUMERO1 + 1 Next DATO1 NUMERO2 = 0 For NUMERO1 = LBound(Array_1) To UBound(Array_1) If Array_1(NUMERO1) <> vbNullString Then ReDim Preserve A_temp1(NUMERO2) A_temp1(NUMERO2) = Array_1(NUMERO1) NUMERO2 = NUMERO2 + 1 End If Next NUMERO1