Question

有一种方法可以使用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

其他解决方案，Filter功能并不关心完全匹配＆＃39;。这个新的需要参考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

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

Answer 3

这是另一个版本：

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 Scripting Runtime

缺点：

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

Answer 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

这段代码对我来说足够快

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

4 个答案: