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

【问题标题】：VBA Removing duplicates values in an array including the same valueVBA删除包含相同值的数组中的重复值
【发布时间】：2021-05-06 12:11:42
【问题描述】：

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

示例：

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

结果：

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

【问题讨论】：

标签： excel vba

【解决方案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

其他解决方案作为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

【讨论】：

谢谢，我也看到了 ReDim Preserve 的实际用途
很高兴您喜欢这个解决方案。但是，我已经意识到第一个想法的一些缺点，因此我添加了其他解决方案。

【解决方案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

优点：

短代码
决策标准独立于循环的后续迭代，因此如果您在算法中构建它，您可以继续处理第一个元素，而无需等待后续元素的决策
不依赖 MS 脚本运行时

缺点：

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

【讨论】：

【解决方案3】：

如何使用 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

【讨论】：

【解决方案4】：

Function no_dupl_array(src As Variant) As Variant
' 1d array
Dim i As Integer, j As Integer, temp As Variant, n As Integer, k As Integer
ReDim temp(0)
    Do While k < UBound(src)
        temp(k) = src(k)
            j = k
        For i = k To UBound(src)
            If src(i) <> temp(k) Then
                j = j + 1
                ReDim Preserve temp(j)
                temp(j) = src(i)
            End If
        Next
        src = temp
        k = k + 1
        ReDim Preserve temp(k)
    Loop
no_dupl_array = src
End Function

这段代码对我来说足够快

【讨论】：