VBA Сравните массивы разных размеров и создайте новый

Question

У меня есть одномерный массив, сгенерированный списком строк, который я хотел бы использовать для сопоставления с основным 2D-массивом со строками в первом столбце и числами во всех остальных.Цель состоит в том, чтобы создать третий массив с соответствующими строками и соответствующими данными из мастера.Не мог найти лучшего решения от поиска здесь, хотя субъект не неизвестен.Думаю, я заблудился при создании нового массива.

Private Sub ImportSelection()
    Dim i, j, k, m, ListSize As Integer
    Dim arr2() As String
    Dim pArr As variant     
    Dim Size As Integer

    Size = List2.ListCount
    ReDim ListBoxContents(0 To Size) As String

    For i = 1 To Size
        ListBoxContents(i) = List2.list(i)
    Next i

    On Error GoTo eh
    ReDim arr2(1 To List2.ListCount, 1 To 16)

    For i = LBound(ListBoxContents) To UBound(ListBoxContents)
        For j = LBound(pArr, 1) To UBound(pArr, 1)
                If ListBoxContents(i) = pArr(i, 1) Then
                    arr2(k, m) = pArr(i, j)
                    k = k + 1
                    m = m + 1
                End If
            Next j
        Next i
eh:
    MsgBox Err.Description
End Sub

Answer 1

Измените среднюю часть кода на ->

k = 0  ' need to initialize (and also add headings to row zero)
For i = LBound(ListBoxContents) To UBound(ListBoxContents)
    For j = LBound(pArr, 1) To UBound(pArr, 1)
            If ListBoxContents(i) = pArr(J, 1) Then  ' pArr needs to be J
                k = k + 1   ' got a match, ergo increment the output row
                For m = 0 To UBound(pArr, 2) - 1
                    arr2(k, m) = pArr(J, m)  ' move into col m, from pArr J row
                Next m                
            End If
    Next j
Next i
Exit Sub  ' do not drop thru

Также как Comintern sez -> pArr никогда не присваивается значение.

Кроме того, вы получаете то, что вы хотите от

Dim i, j, k, m, ListSize As Integer