Question

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

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

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)

当您进行重新设定时，您需要在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

在VBA中重新生成一个数组

2 个答案: