arrays - 将二维数组发布到 Excel 工作表

Question

该函数用作“ Assets 类别分配”引擎(在参数范围内具有约束)并在数组的每一行上模拟投资组合模型。我尝试使用四种方法将数组发布到工作表上，但每种方法都失败了。

对于 Assets A、B、C、D 中的每个 Assets 权重，这些参数在 M3:O6 中配置为 {Min 5, Max 100, Step 5}。

该函数无法将二维数组粘贴到 Excel 中。有 970 个排列，所以数组是 970x5。这是尺寸问题吗？代码可以正常工作到 PrintArray AllocArray, ActiveWorkbook.Worksheets("Test").[A1]Sub PrintArray(Data As Variant, Cl As Range)
Cl.Resize(UBound(Data, 1), UBound(Data, 2)) = Data
End Sub

Function ConfigureArrayFolly()

Dim Param() As Variant
Param = Range("M3:O6")

Dim AMin, AMax, AStep, BMin, BMax, BStep, CMin, CMax, CStep, DMin, DMax, DStep As Double

AMin = Param(1, 1): AMax = Param(1, 2): AStep = Param(1, 3)
BMin = Param(2, 1): BMax = Param(2, 2): BStep = Param(2, 3)
CMin = Param(3, 1): CMax = Param(3, 2): CStep = Param(3, 3)
DMin = Param(4, 1): DMax = Param(4, 2): DStep = Param(4, 3)


Dim nSim As Double: nSim = (1 + (AMax - AMin) / AStep) * (1 + (BMax - BMin) / BStep) * (1 + (CMax - CMin) / CStep) * (1 + (DMax - DMin) / DStep)
Dim nAsset As Double: nAsset = 4 ' Count {A, B, ... , F}

'Debug.Print nSim

Dim AllocArray() As Variant
ReDim AllocArray(1 To 970, 0 To nAsset)

Dim Sim As Integer: Sim = 1
Dim A As Double
Dim B As Integer
Dim C As Integer
Dim D As Integer

For A = AMin To AMax Step AStep
    For B = BMin To BMax Step BStep
    'If (A + B) > 100 Then GoTo endB
        For C = CMin To CMax Step CStep
        'If (A + B + C) > 100 Then GoTo endC
            For D = DMin To DMax Step DStep
                        ' nAsset is the count of set {a1, a2 ... an}
                        ' AllocArray(1, 2, 3) = (Sim, a1, a2)

                        'Constraints
                        If (A + B + C + D) <> 100 Then GoTo endD
                        Debug.Print Sim; A; B; C; D

                        AllocArray(Sim, 0) = Sim
                        AllocArray(Sim, 1) = A
                        AllocArray(Sim, 2) = B
                        AllocArray(Sim, 3) = C
                        AllocArray(Sim, 4) = D
                        Sim = Sim + 1

                       ' Debug.Print "Sim "; Sim; AllocArray(1, 1)
endD:
            Next D
endC:
        Next C
endB:
    Next B
Next A


' Print to sheet - Method One  (fails)
    Dim NumRows As Long: Dim NumCols As Long
    NumRows = UBound(AllocArray, 1) - LBound(AllocArray, 1) + 1
    NumCols = UBound(AllocArray, 2) - LBound(AllocArray, 2) + 1
    Set Destination = Range("D20").Resize(NumRows, NumCols).Value = AllocArray

' Print to sheet - Method Two (fails)
    'Sheets("Test").Range("D20").Value = AllocArray(1, 1)

'Print to sheet - Method Three (fails)
    PrintArray AllocArray, ActiveWorkbook.Worksheets("Test").[D20]

'Print to sheet - Method Four (fails)
    Range("D20:H989").Value = AllocArray

    Sheets("Test").Range("D20").Resize(Sim, NumCols).Value = AllocArray

    'Range(D20:G6002) = AllocArray

    ConfigureArrayFolly = nSim
    End Function

Answer 1

您的数组对每个维度都有不同的下限。

您需要通过将 1 添加到 UBound(Data,2) 来进行调整。 :

Sub PrintArray(Data As Variant, Cl As Range)
    Cl.Resize(UBound(Data, 1), UBound(Data, 2) + 1) = Data
End Sub