时间戳

首页 > 解决方案 > 比较两个数组并将匹配的字符串添加到另一个数组

arrays - 比较两个数组并将匹配的字符串添加到另一个数组

问题描述

所以我有两个数组。其中一个是 1D (AllAssigneesUnique)，另一个是 2D (DB_Array)。我想将 (AllAssigneesUnique) 与 (DB_Array) 的第一列进行比较，当存在完全匹配时，将字符串从 (DB_Array) 的第一列和第二列存储到名为 (NewAssigneesArray) 的第三个 3D 数组中。此外，(NewAssigneesArray) 的第三列应该有字符串“New”。以下是我到目前为止的代码。PS由于匹配字符串的数量并不总是相同，我如何自动重新调整新数组的尺寸？目前，我正在使用以前制作的字典来获取匹配字符串的确切数量。

Dim NewAssigneesArray() As Variant
ReDim NewAssigneesArray(1 To NewAssigneesList.count, 1 To 3)


For a = LBound(AllAssigneesUnique) To UBound(AllAssigneesUnique)
    For b = LBound(DB_Array, 1) To UBound(DB_Array, 1)
        If AllAssigneesUnique(a) = DB_Array(b, 1) Then
            For i = LBound(NewAssigneesArray) To UBound(NewAssigneesArray)
                NewAssigneesArray(i, 1) = DB_Array(b, 1)
                NewAssigneesArray(i, 2) = DB_Array(b, 2)
                NewAssigneesArray(i, 3) = "New"
            Next i
        End If
    Next b
Next a

标签： arraysexcelvbacompare

解决方案

下面的代码由于明显的原因未经测试，可能包含拼写错误或小错误。我相信您将能够纠正它们。请注意，将数组的维度设置为大于所需的大小并在最后给出最终大小会更有效。大 UBound 不需要 RAM 空间。

Sub CreateNewArray()

    Dim NewAssigneesArray() As Variant
    Dim i As Long
    Dim a As Long, b As Long

    ' set a (UBound, 2) a lot higher than what you will ever need.
    ' note that you can't Redim (UBound, 1), only (UBound, 2)
    ReDim NewAssigneesArray(1 To 3, 1 To 5000)

    For a = LBound(AllAssigneesUnique) To UBound(AllAssigneesUnique)
        For b = LBound(DB_Array, 1) To UBound(DB_Array, 1)
            ' Use VbBinaryCompare for a case sensitive comparison
            If StrComp(AllAssigneesUnique(a), DB_Array(b, 1), vbTextCompare) = 0 Then
                i = i + 1
                NewAssigneesArray(1, i) = DB_Array(b, 1)
                NewAssigneesArray(2, i) = DB_Array(b, 2)
                NewAssigneesArray(3, i) = "New"
                Exit For
            End If
        Next b
    Next a
    ReDim Preserve NewAssigneesArray(1 To 3, 1 To i)
End Sub

推荐阅读