从vba中的数组中间删除一个项目答案

【问题标题】：Deleting an item from middle of an array in vba从vba中的数组中间删除一个项目
【发布时间】：2022-11-17 16:43:30
【问题描述】：

从vba中的数组中间删除一个项目

我正在遍历两个数组以查找 Arr1 中的哪一项等于 Arr2。然后我想从 Arr1 中删除该项目。最后，我会将 Arr1 添加到 Arr2。所以，它以某种方式检测 Arr1 是否有不在 Arr2 中的新项目，并将该项目添加到 Arr2

Public Sub cmpArr()

For i =LBound(Arr1) To UBound(Arr2)
    For j = LBound(Arr2) To UBound(Arr2)
         If Arr1(i) = Arr2(j) Then
            'Arr1(i) delete
         End If
    Next j
Next i

End Sub

【问题讨论】：

它必须是一个数组吗？这不是创建唯一项目列表的最佳方式。你试过Scripting Dictionary吗？
或者，您可以查看ReDim Preserve，但它速度慢且更复杂。
另一种选择是 Collection
我推荐字典，因为您可以轻松检查它是否已经是成员，完成后，您可以轻松引用其键数组。（所以有你的阵列）
是的，我认为按键删除是我在数组中所需要的。我会将我的数组更改为字典

标签： arrays vba duplicates

【解决方案1】：

请尝试下一种方法：

Sub replaceArrayElem()
  Dim arr1, arr2, arr3, mtch, i As Long, j As Long
  arr1 = Array("a", "c", "d", "jj", "t", "www")
  arr2 = Array("m", "r", "o", "c", "uu", "n", "d")
  For i = LBound(arr2) To UBound(arr2)
        mtch = Application.match(arr2(i), arr1, 0)
        If IsNumeric(mtch) Then 'if a match exists
            arr1(mtch - 1) = "#$@!": arr1 = filter(arr1, "#$@!", False) 'filter eliminate a specific element
        End If
  Next i
  Debug.Print Join(arr1, ",") ' just to visually see how arr1 remained
  arr3 = arr2: ReDim Preserve arr3(UBound(arr2) + UBound(arr1) + 1)
  For i = UBound(arr2) + 1 To UBound(arr3)
       arr3(i) = arr1(j): j = j + 1
  Next i
  Debug.Print Join(arr3, ",") 'the returned array...
End Sub

请在测试后发送一些反馈。

还有一个使用 Scripting.Dictionary 的版本（如果你有数组，或者喜欢使用它们）：

Sub replaceArrayElemDict()
  Dim arr1, arr2, arr3, mtch, i As Long, j As Long
  Dim dict As Object
  
  arr1 = Array("a", "c", "d", "jj", "t", "www")
  arr2 = Array("m", "r", "o", "c", "uu", "n", "d")
  
  Set dict = CreateObject("Scripting.Dictionary")
  For i = LBound(arr2) To UBound(arr2)
        dict(arr2(i)) = vbNullString
  Next i
  For i = LBound(arr1) To UBound(arr1)
        If Not dict.Exists(arr1(i)) Then dict(arr1(i)) = vbNullString
  Next i
  
  Debug.Print Join(dict.Keys, ",") 'the returned array...
End Sub

【讨论】：