您的位置: 首页  >  技术问答  >  VBA 转置数组长度限制的最佳解决方法?

VBA 转置数组长度限制的最佳解决方法?

分类: 技术问答 • 2022-05-10 08:35:22
问题描述：

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

After running a simulation with 100,000 iterations, I tried to dump the values from each iteration into a column. Here is the gist of the code:

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) 的数组.那么，我应该如何解决这个问题?我最有效的选择是什么?

This throws a Type Mismatch error on the next to last line because Transpose can only handle arrays of length up to 2^16 (~64,000). So, how should I workaround this? What is my most efficient option?

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

I set up my code to store the values in an array just for the easy output, but it seems that's not going to work for this many values. Would I be better off sticking with arrays and just write my own transpose function (i.e., loop through the array and write the values to a new array), or would I be better off working with a different class from the start, like a collection, if I'm just going to have to loop through the results in the end anyway?

或者更好的是，有没有办法无需再次遍历这些值?

Or better yet, is there anyway to do this without having to loop through the values again?

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

I provided a bad example because the ReDim Preserve calls were unnecessary. So, consider the following instead where they are necessary.

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)

答

这是您的代码的一个版本，它应该可以工作并且速度更快:

Here's a version of your code that should work and be faster:

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

' ReDim it completely first, already transposed:
ReDim totalgoals(1 To iter, 1 To 1) As Variant

For i = 1 To iter
    ko.Calculate
    totalgoals(i, 1) = ko.Range("F23").Value
Next i
out.Range("U1:U" & iter) = totalgoals
Application.ScreenUpdating = True
End Sub

这是一个保留条件 ReDims 的版本，但在末尾手动转置数组:

Here's a version that keeps the conditional ReDims, but manually transposes the array at the end:

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
' manually transpose it
Dim trans() As Variant
ReDim trans(1 to UBound(totalgoals), 1 to 1)
For i = 1 to UBound(totalgoals)
    trans(i, 1) = totalgoals(1, i)
Next i
out.Range("U1:U" & iter) = trans
Application.ScreenUpdating = True
End Sub

相关推荐