Redim Preserve 和 Application.Transpose 更改数组基数时出现 VBA 错误答案

【问题标题】：VBA Error with Redim Preserve and Application.Transpose changing array baseRedim Preserve 和 Application.Transpose 更改数组基数时出现 VBA 错误
【发布时间】：2019-03-20 19:01:23
【问题描述】：

我有一个二维数组。我想在它的第一个维度上做一个 redim 保留，但我知道 redim preseve 只在最后一个维度上有效。我尝试使用转置功能，但似乎转置正在将我的数组从基数 0 更改为基数 1，这正常吗？如果是，如何将其设置回基数 0？或者如何解决我的问题以在更改数组的第一个维度时保留我的数组？我想在我的数组中添加 2 个元素

这是我遇到问题的代码的一部分：

    table3 = Application.Transpose(table3)
    ReDim Preserve table3(Ubound(table3,1), Ubound(table3,2) +2)
    table3 = Application.Transpose(table3)

我注意到，在转置之前，数组的底数为 0，转置后的底数为 1，我认为这是主要问题。我不想将基数从 0 更改为 1，因为我在代码的其他地方使用了相同的数组，并且我不想更改整个代码。

下面这行代码会报错

“下标超出范围”

ReDim Preserve table3(Ubound(table3,1), Ubound(table3,2) +2)

如果我通过以下行更改它

ReDim Preserve table3(1 To UBound(table3, 1), UBound(table3, 2) + 2)

它会工作，但我的数组将成为一个基于 1 的数组，这不是我想要的，我想让我的索引从 0 开始而不是从 1

转置前

转置后

【问题讨论】：

ReDim Preserve table3(0 To UBound(table3, 1), UBound(table3, 2) + 1)
我在发布之前已经尝试过了，但它失败了。我也试过 0 到 ubound(table3,1)-1 没用。
您可以编写一个小实用函数来转置数组而不更改其下限...您不需要使用Application.Transpose 或者编写一个函数来直接执行调整大小而不进行任何转置。 stackoverflow.com/questions/13183775/…
@user11217663 - 转置确实改变了边界（如果原始下限不是 1）输出下限总是 1
table3 是如何声明和填充的？

标签： excel vba

【解决方案1】：

也许这会对你有所帮助：

'********************************************************************************************************************
' To re-dimension the first dimension of a two-dimension array without getting Excel errors
' Also possible to re-dimension the second dimension
' Usage: myArray = reDimPreserve(myArray, UBound(myArray, 1) + x, UBound(myArray, 2) + y)
' Where x and y are the increments to get to the desired new dimensions
' Returns an empty array if there was an error
'********************************************************************************************************************
Public Function reDimPreserve(ByVal aArray As Variant, ByVal newFirstUBound As Long, ByVal newLastUBound As Long) As Variant
Dim tmpArr As Variant, nOldFirstUBound As Long, nOldLastUBound As Long, nFirst As Long, nLast As Long

If Not IsArray(aArray) Then
    reDimPreserve = Array(Empty)
ElseIf newFirstUBound < UBound(aArray, 1) Or newLastUBound < UBound(aArray, 2) Then
    reDimPreserve = Array(Empty)
Else
    ReDim tmpArr(newFirstUBound, newLastUBound)
    nOldFirstUBound = UBound(aArray, 1)
    nOldLastUBound = UBound(aArray, 2)
    For nFirst = LBound(aArray, 1) To newFirstUBound
        For nLast = LBound(aArray, 2) To newLastUBound
            If nOldFirstUBound >= nFirst And nOldLastUBound >= nLast Then
                tmpArr(nFirst, nLast) = aArray(nFirst, nLast)
            End If
        Next nLast
    Next nFirst
    reDimPreserve = tmpArr
    Erase tmpArr
End If

End Function

【讨论】：

非常感谢您的功能完美运行。