在VBA中重新定义数组

问题描述

在VBA中调整二维数组的大小时，我遇到了严重的问题.我已经阅读了很多有关此(热门)问题的文章，但仍然无法弄清楚代码中的错误.

I have a serious problem with resizing a 2-dimensional array in VBA. I've done a lot of reading about this (popular) issue, but still I can't figure out what's wrong in my code.

因此，我在电子表格中有一些数据.在第二行中，我对元素进行了一些描述，而在第一行中，我具有这些元素的类别.我想做的是创建一个数组，该数组在第一行中具有(不同)类别，在第二行中具有与特定类别相关的描述索引.该代码可以正常工作直到 如果j = UBound(distinctList，2)，则然后ReDim进入，并且出现下标超出范围错误".如果在其中添加一个新类别，并且在电子表格中的条目与新数组中的任何条目不相等的情况下，该If会插入.

So, I have some data in a spreadsheet. In the second row I have some descriptions of an element, while in the first row I have categories of those elements. What I want to do is create an array which has (distinct) categories in the first row and indexes of descriptions related to a particular category in the second row.The code works correctly up until If j = UBound(distinctList, 2) ThenThen ReDim comes in and I get a "Subscript out of range error".That If is there to add a new category and is meant to kick in if the entry from the spreadsheet does not equal any entry from the new array.

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

推荐答案

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

It's because you can't change the lower bound of the second dimension, you need to keep it the same..

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

重做时，您需要将第二维的下限保持在0

when you redim, you need to keep lower bound of the second dimension at 0

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

这篇关于在VBA中重新定义数组的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！