1

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

所以，我在电子表格中有一些数据。在第二行中，我有一些元素的描述，而在第一行中，我有这些元素的类别。我想要做的是创建一个数组，该数组在第一行中具有（不同的）类别，在第二行中具有与特定类别相关的描述索引。代码正常工作，直到 If j = UBound(distinctList, 2) Then Then 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
4

2 回答 2

2

这是因为您无法更改第二维的下限，您需要保持不变..

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

当您重新调整时，您需要将第二维的下限保持在0

ReDim Preserve distinctList(0 To 1, 0 To UBound(distinctList, 2) + 1)
于 2013-11-08T09:44:50.510 回答
0

如果您应用此代码来更改 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
于 2018-09-15T19:37:56.693 回答