Сравните два массива и добавьте соответствующие строки в другой массив

Question

Итак, у меня есть два массива. Один из них - 1D (AllAssigneesUnique), а другой - 2D (DB_Array). Я хочу сравнить (AllAssigneesUnique) с первым столбцом (DB_Array) и, когда есть точное совпадение, сохранить строку из первого и второго столбца (DB_Array) в третий 3D-массив с именем (NewAssigneesArray). Кроме того, третий столбец (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

Answer 1

Приведенный ниже код не проверен по очевидным причинам и может содержать опечатки или небольшие ошибки. Я верю, что вы сможете исправить их. Обратите внимание, что более эффективно измерять массив больше, чем требуется, и в конце дать ему окончательный размер. Большой UBound не требует места в оперативной памяти.

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

Answer 2

Альтернатива ReDim Preserve

Правильное решение @Variatus использует массив с обращенными размерами строки / столбца, чтобы преодолеть ограничение, которое ReDim Preserve работает только в последнем (здесь: 2) измерение.

В качестве альтернативы я демонстрирую обходной путь, который реструктурирует 1-е измерение / т.е. строки / напрямую (оставляя 2-е нетронутым) через функцию Application.Index():

NewAssigneesArray= Application.Index(NewAssigneesArray, Evaluate("row(1:" & i & ")"), Array(1, 2, 3))

Ссылка

Подробнее о некоторых особенностях функции Application.Index()"в Вставка первого столбца в массив полей данных без циклов или вызова API