Ponowne obliczanie tablicy w VBA

Mam poważny problem z zmianą rozmiaru dwuwymiarowej tablicy w VBA. Dużo czytałem o tym (popularnym) problemie, ale wciąż nie mogę zrozumieć, co jest nie tak w moim kodzie.

Mam więc dane w arkuszu kalkulacyjnym. W drugim rzędzie mam pewne opisy elementu, podczas gdy w pierwszym rzędzie mam kategorie tych elementów. Chcę utworzyć tablicę, która ma (różne) kategorie w pierwszym wierszu i indeksy opisów związanych z określoną kategorią w drugim wierszu. Kod działa poprawnie do momentu, aż If j = UBound (distinctList, 2) Następnie pojawi się ReDim i otrzymam „błąd poza zakresem indeksu”. Jeśli If istnieje, aby dodać nową kategorię i ma się włączyć, jeśli wpis z arkusza kalkulacyjnego nie jest równy żadnemu wpisowi z nowej tablicy.

Function distinctValues(arr)
Dim distinctList() As String
Dim j As Integer
k = 0

'ReDim distinctList(0 To 0, 0 To 1)

'Dodaj pierwszy wpis
For i = LBound(arr) To UBound(arr)
    If arr(i) <> "" Then
        ReDim distinctList(0 To 1, 0 To j)
        distinctList(0, 0) = arr(i)
        distinctList(1, 0) = i + 1
        'k = k + 1
        Exit For
    End If
Next i

'Dodaj kolejne wpisy
For i = LBound(arr) + 1 To UBound(arr)
    If arr(i) <> "" Then
        For j = LBound(distinctList, 2) To UBound(distinctList, 2)
            If arr(i) = distinctList(0, j) Then
                distinctList(1, j) = distinctList(1, j) & ", " & i + 1
                'k = k + 1
                Exit For
            End If
            If j = UBound(distinctList, 2) Then
                ReDim Preserve distinctList(0 To 1, 1 To UBound(distinctList, 2) + 1)
                distinctList(0, j) = arr(i)
                distinctList(1, j) = distinctList(UBound(distinctList, 2), 1) & ", " & i + 1
                Exit For
            End If
        Next j
    End If
Next i


Debug.Print distinctList(0, 0) & " => " & distinctList(1, 0)
'distinctValues = distinctList

End Function

questionAnswers(2)

yourAnswerToTheQuestion