在 VBA 中重新设置数组

Question

我在 VBA 中调整二维数组的大小时遇到​​了严重问题。我已经阅读了很多关于这个（流行）问题的资料，但我仍然无法弄清楚我的代码有什么问题。

所以，我在电子表格中有一些数据。在第二行中，我有一些元素的描述，而在第一行中，我有这些元素的类别。我想要做的是创建一个数组，该数组在第一行中具有（不同的）类别，在第二行中具有与特定类别相关的描述索引。 代码正常工作，直到 如果 j = UBound(distinctList, 2) 那么 然后 ReDim 进来了，我得到一个“下标超出范围错误”。 如果电子表格中的条目不等于新数组中的任何条目，则该 If 用于添加新类别。

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

Answer 1

这是因为你不能改变第二维的下界，你需要保持不变..

你在顶部声明ReDim distinctList(0 To 1, 0 To j)

redim时，需要将第二维的下限保持在0

ReDim Preserve distinctList(0 To 1, 0 To UBound(distinctList, 2) + 1)

Answer 2

如果您应用此代码来更改 nr，我认为您可以将此通用解决方案应用于您的特定解决方案。添加/新类别之前的维度。

Option Explicit
Public Sub redimarray()
    'This sub redimensions an array as an array of arrays, so to acces the k'th element in the n-th dimension you need to type: my_array(n)(k)
    'and you can still simply redefine the array dimensions by:
    'my_array =FlexArray("lower_bound_n-th_dim,lower_bound_n-th_dim,_n+1-th_dim,upper_bound_n-th_dim,_n+1-th_dim) = e.g.: FlexArray("2,3,9,11")

    'if you then want to have conventional array element conventional_array(3,4) you can copy the entire my_array into a 1 dimensional array where
    ' the array elements are added like a (nr-of_elements_per_dimension)-base numbering system. once they have been manipulated, you can store them back into
    'nr of elements per dimension:
    'dim 0 = 4, 0-3
    'dim 1 = 3, 4-6
    'dim 2 = 8, 1-8
    'nr of elements in 1dim array = 4*3*8 = 96
    '(0)(4)(1)
    '(0)(4)(2)
    '...
    '(0)(4)(8)
    '(0)(5)(1)
    'so working_array(3,5,2) = (3-0)*nr_elem(dim 1)*nr_elem(dim 2)+(5-4)*nr_elem(dim 2)+(2-1)

    'dim 0 = nr_elements(0), start_element(0)-end_element(0)
    'dim 1 = nr_elements(1), start_element(1)-end_element(1)
    'dim 2 = nr_elements(2), start_element(2)-end_element(2)
    'so working_array(3,5,2) = (end_element(0)-start_element(0))*nr_elements(1)*nr_elements(2)+(end_element(1)-start_element(1))*nr_elements(2)+'so working_array(3,5,2) = (end_element(0)-start_element(0))*nr_elements(1)*nr_elements(2)+(end_element(2)-start_element(2))=index in 1 dimensional array.

    Dim NewArray() As Variant

    NewArray = FlexArray("1,2,3,8,2,9")
    'NewArray = FlexibleArray("1,2,3,8,2,9")
    MsgBox (NewArray(1)(8))

End Sub
Public Function FlexArray(strDimensions As String) As Variant

    Dim arrTemp     As Variant
    Dim varTemp     As Variant

    Dim varDim      As Variant
    Dim intNumDim   As Integer

    Dim iDim        As Integer
    Dim iArr        As Integer

    varDim = Split(strDimensions, ",")
    intNumDim = (UBound(varDim) + 1) / 2

    ' Setup redimensioned source array
    ReDim arrTemp(intNumDim)

    iArr = 0
    For iDim = LBound(varDim) To UBound(varDim) Step 2

        ReDim varTemp(varDim(iDim) To varDim(iDim + 1))
        arrTemp(iArr) = varTemp
        iArr = iArr + 1
    Next iDim

    FlexArray = arrTemp
End Function