2

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

例子：

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

结果：

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

4 回答 4

4

试试这个代码：

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
于 2013-04-08T11:19:19.510 回答
0

如何使用 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
于 2016-11-08T20:55:22.430 回答
0

这是另一个版本：

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) 没有出现在任何地方（但是这很可能）
于 2016-11-08T21:54:55.920 回答
0 
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

这段代码对我来说足够快

于 2021-05-06T04:06:11.473 回答