vba - VBA Transpose 数组长度限制的最佳解决方法？

Question

运行 100,000 次迭代的模拟后，我尝试将每次迭代的值转储到列中。这是代码的要点:

Sub test()
Application.ScreenUpdating = False
Dim totalgoals() As Variant, ko As Worksheet, out As Worksheet, iter As Long
Set ko = Sheets("KO Sim")
Set out = Sheets("Monte Carlo")
iter = out.Range("P2").Value
For i = 1 To iter
    ko.Calculate
    If i = 1 Then
        ReDim totalgoals(1 To 1, 1 To 1) As Variant
        totalgoals(1, 1) = ko.Range("F23").Value
    Else
        ReDim Preserve totalgoals(1 To 1, 1 To i) As Variant
        totalgoals(1, i) = ko.Range("F23").Value
    End If
Next i
out.Range("U1:U" & iter) = Application.WorksheetFunction.Transpose(totalgoals)
Application.ScreenUpdating = True
End Sub

这会在倒数第二行引发类型不匹配错误，因为 Transpose 只能处理长度最大为 2^16 (~64,000) 的数组。那么，我应该如何解决这个问题？我最有效的选择是什么？

我设置代码将值存储在数组中只是为了方便输出，但似乎这不适用于这么多值。我是否最好坚持使用数组并编写自己的转置函数(即循环遍历数组并将值写入新数组)，或者我最好从一开始就使用不同的类，例如集合，如果我最后还是要循环遍历结果？

或者更好的是，有没有办法不需要再次循环遍历这些值来执行此操作？

编辑:

我提供了一个错误的示例，因为 ReDim Preserve 调用是不必要的。因此，在必要时请考虑以下内容。

ReDim totalgoals(1 To 1, 1 To 1) As Variant
For i = 1 To iter
    ko.Calculate
    If ko.Range("F23") > 100 Then
        If totalgoals(1, 1) = Empty Then
            totalgoals(1, 1) = ko.Range("F23").Value
        Else
            ReDim Preserve totalgoals(1 To 1, 1 To UBound(totalgoals, 2) + 1) As Variant
            totalgoals(1, UBound(totalgoals, 2)) = ko.Range("F23").Value
        End If
    End If
Next i
out.Range("U1").Resize(UBound(totalgoals, 2),1) = Application.WorksheetFunction.Transpose(totalgoals)

Answer 1

计算肯定会成为这里的瓶颈，因此(正如 RBarryYoung 所说)逐项转置数组并不会真正影响宏的运行速度。

也就是说，有一种方法可以在恒定时间内将 2D 行转置为列(反之亦然):

Private Declare Function VarPtrArray Lib "msvbvm60" Alias _
    "VarPtr" (ByRef Var() As Any) As Long
Private Declare Sub GetMem4 Lib "msvbvm60.dll" (src As Any, dest As Any)
Private Declare Sub GetMem8 Lib "msvbvm60.dll" (src As Any, dest As Any)

Sub test()
    Dim totalgoals() As Single
    Dim f As Single
    Dim i As Long, iter As Long

    'dimension totalgoals() with as many cells as we
    'could possibly need, then cut out the excess
    iter = 100000
    ReDim totalgoals(1 To 1, 1 To iter)
    For iter = iter To 1 Step -1
        f = Rnd
        If f > 0.2 Then
            i = i + 1
            totalgoals(1, i) = f
        End If
    Next iter
    ReDim Preserve totalgoals(1 To 1, 1 To i)

    'transpose by swapping array bounds in memory
    Dim u As Currency
    GetMem8 ByVal VarPtrArray(totalgoals) + 16, u
    GetMem8 ByVal VarPtrArray(totalgoals) + 24, _
            ByVal VarPtrArray(totalgoals) + 16
    GetMem8 u, ByVal VarPtrArray(totalgoals) + 24
End Sub