如何在VBA中创建n个数组

我有下面的代码，它可以完美地工作并完成我需要的技巧。

但是我希望这段代码运行 n 次并创建 n 个数组。

我的数据集是：

我的代码是：

Option Explicit

Private Sub Test()
    Const startRow As Long = 2
    Const valueCol As Long = 2
    Const outputCol As Long = 4
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
        
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, valueCol).End(xlUp).Row
    
    Dim inputArr As Variant
    inputArr = ws.Range(ws.Cells(startRow, valueCol), ws.Cells(lastRow, valueCol)).Value
    
    Dim outputSize As Long
    outputSize = ((UBound(inputArr, 1) - 1) * UBound(inputArr, 1)) / 2
    
    Dim outputIndex As Long
    Dim outputArr As Variant
    ReDim outputArr(1 To outputSize, 1 To 1) As Variant
    
    Dim i As Long
    Dim n As Long
    
    Dim currFirst As Long
    Dim currLowest As Long
    
    For i = 2 To UBound(inputArr, 1)
        currFirst = inputArr(i, 1)
        currLowest = currFirst - inputArr(i - 1, 1)
                
        For n = i - 1 To 1 Step -1
            Dim testLowest As Long
            testLowest = currFirst - inputArr(n, 1)
            
            If testLowest < currLowest Then currLowest = testLowest
            
            outputIndex = outputIndex + 1
            outputArr(outputIndex, 1) = currLowest
        Next n
    Next i
    
    ws.Cells(startRow, outputCol).Resize(UBound(outputArr, 1)).Value = outputArr
End Sub

代码解释：（数据集仅用于视觉目的） 代码计算列（例如 B 列）中的值并创建 array1 并将数组插入到结果列中。

我想要实现的是重复此代码/循环 n 次并创建动态数量的数组，然后将这些数组的结果放入结果列中。我不知道如何在一个循环内创建 array1 然后 array2 等等。

一列可能有 60k+ 行，因此我需要非常轻量级的解决方案来实现最短的运行时间。

感谢您的帮助。

Edit:

Added picture

这假设您的日期和值始终成对，因此您使用的列始终是偶数。

基本上添加了另一个循环来遍历列，并在每列计算结束时添加outputArr into a Collection (outputColl）。我在最后添加了如何迭代集合和每个数组的行的示例。

Option Explicit

Private Sub Test()
    Const startRow As Long = 2
    Const firstValueCol As Long = 2
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
        
    Dim lastRow As Long
    Dim lastCol As Long
    
    With ws
        lastRow = .Cells(.Rows.Count, firstValueCol).End(xlUp).Row
        lastCol = .Cells(startRow, .Columns.Count).End(xlToLeft).Column
    End With
    
    Dim outputSize As Long
    outputSize = ((lastRow - startRow) * (lastRow - startRow + 1)) / 2
            
    Dim outputArr As Variant
    ReDim outputArr(1 To outputSize, 1 To 1) As Variant
    
    Dim outputColl As Collection
    Set outputColl = New Collection
        
    Dim x As Long
    Dim i As Long
    Dim n As Long
    
    For x = firstValueCol To lastCol Step 2
        Dim inputArr As Variant
        inputArr = ws.Range(ws.Cells(startRow, x), ws.Cells(lastRow, x)).Value
            
        Dim outputIndex As Long
        outputIndex = 0
        
        For i = 2 To UBound(inputArr, 1)
            Dim currFirst As Long
            Dim currLowest As Long
            
            currFirst = inputArr(i, 1)
            currLowest = currFirst - inputArr(i - 1, 1)
                    
            For n = i - 1 To 1 Step -1
                Dim testLowest As Long
                testLowest = currFirst - inputArr(n, 1)
                
                If testLowest < currLowest Then currLowest = testLowest
                
                outputIndex = outputIndex + 1
                outputArr(outputIndex, 1) = currLowest
            Next n
        Next i
        
        outputColl.Add outputArr
    Next x
    
    'Loop through your collection
    For x = 1 To outputColl.Count
        
        'loop through the rows in the array
        For i = 1 To UBound(outputColl(x), 1)
            'Do your math here
            Debug.Print outputColl(x)(i, 1)
        Next i
    Next x
    
    'Dim outputCol As Long
    'outputCol = lastCol + 1
    'ws.Cells(startRow, outputCol).Resize(UBound(outputArr, 1)).Value = outputArr
End Sub