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

VBA Removing duplicates values in an array including the same value

提问by Jonathan Raul Tapia Lopez

There is a way to remove all duplicates in array with VBA, also the first value. Just keeping the not Duplicated values

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

Example:

例子：

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

Result:

结果：

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

回答by Kazimierz Jawor

Try this code:

试试这个代码：

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

Additional solutionas Filterfunction doesn't care about 'exact match'. This new one requires reference to Microsoft Scripting Runtime in VBA project.

作为Filter函数的附加解决方案不关心“完全匹配”。这个新的需要参考 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

回答by Raul Fernandez Marques

How create a new A_temp1() without duplicates, using Filter() VBA function:

如何使用 Filter() VBA 函数创建一个没有重复的新 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

回答by z32a7ul

Here is another version:

这是另一个版本：

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

Advantages:

好处：

• Shorter code
• The decision criterion is independent of later iterations of the loop, so if you build it in your algorithm, you can proceed with the first element without waiting for the decision about later ones
• Does not rely on MS Scripting Runtime

• 较短的代码
• 决策标准与循环的后续迭代无关，因此如果您在算法中构建它，则可以继续处理第一个元素，而无需等待有关后续元素的决策
• 不依赖 MS Scripting Runtime

Disadvantages:

缺点：

• Less efficient for larger arrays
• Outputs a Collection instead of an array (requires a loop to convert into an array if that is needed)
• Assumes that the array contains only text and that ASCII 1 (SOH) does not appear anywhere (which is quite probable, however)

• 对于较大的阵列效率较低
• 输出集合而不是数组（如果需要，需要循环转换为数组）
• 假设数组只包含文本并且 ASCII 1 (SOH) 没有出现在任何地方（但是很有可能）