ReDim 保留 3D VBA

Question

问题：我有以下两个函数可以有效地 ReDim 保留所有维度的 3D 数组，transposeArray3D 和 ReDimPreserve3D。但是，即使我尝试在转置函数中重新设置值，这也会擦除通过这些函数的任何数组。具体来说，当我用鼠标（t和newArray）调试并悬停在临时数组上时，excel 指示数组为空。

上下文：这是将类似于 CSV 的文件转换为 Excel 表格的尝试的一部分，主要是通过拆分 3 个分隔符：3D 数组是跟踪“表格编号”所必需的。我不明白为什么函数不能读取传递给它们的数组。

我已经包含了调用这些函数的过程，以防万一问题不在函数中。

Public Function transposeArray3D(arr3d As Variant) As Variant
    Dim x As Variant, y As Variant, z As Variant, xub As Long, yub As Long, zub As Long, newArray As Variant
    xub = UBound(arr3d, 1) 'x,y,z correspond to dim 1,2,3 of the OLD array
    yub = UBound(arr3d, 2)
    zub = UBound(arr3d, 3)
    ReDim newArray(zub, xub, yub)
    For x = 0 To xub     'x-->y, y-->z, z-->x
        For y = 0 To yub
            For z = 0 To zub
                newArray(z, x, y) = arr3d(x, y, z)
                MsgBox (arr3d(x, y, z))
            Next z
        Next y
    Next x
    transposeArray3D = newArray
End Function

Public Function ReDimPreserve3D(arr As Variant, newx As Long, newy As Long, newz As Long) As Variant
    'ReDim Preserves all dimensions of a 3D array--does not mess with original array
    Dim t As Variant, oldx As Long, oldy As Long, oldz As Long
    oldx = UBound(arr, 1)
    oldy = UBound(arr, 2)
    oldz = UBound(arr, 3)
    ReDim t(oldx, oldy, oldz)
    t = arr
    ReDim Preserve t(oldx, oldy, newz)
    t = transposeArray3D(t)
    ReDim Preserve t(newz, oldx, newy)
    t = transposeArray3D(t)
    ReDim Preserve t(newy, newz, newx)
    t = transposeArray3D(t)
    ReDimPreserve3D = t
End Function

'called from:
Sub csv_to_table()
    
    Dim i As Long, j As Long, k As Long, maxRow As Long, test As Long
    Dim tableCount As Long, nr As Long, nc As Long
    Dim table() As Variant
    ReDim table(0, 0, 0)
    Dim temp1 As Variant, temp2 As Variant 'temp array for each table holding the rows pre-splitting by spaces
    
    maxRow = Cells(rows.Count, 1).End(xlUp).Row
    
    For i = 0 To maxRow
    
        If Not IsEmpty(Cells(i + 1, 1).Value) Then
            
            ReDim Preserve table(UBound(table, 1), UBound(table, 2), i)

            nr = countChar(Cells(i + 1, 1).Text, ";")
            ReDim temp1(nr)
            temp1 = Split(Cells(i + 1, 1), ";") 'holds all the rows of the table in an array
            nc = countChar(CStr(temp1(0)), " ")
            ReDim temp2(nc)
            table = ReDimPreserve3D(table, nr, nc, i)
            
            For j = 0 To nr - 1 'row
                
                temp2 = Split(temp1(j), " ")
                
                For k = 0 To nc - 1 'get table columns (separated by spaces)
                    
                    table(j, k, i) = temp2(k)
                    
                Next k
                
                ReDim temp2(nc)
                
            Next j

            Erase temp1, temp2
        
        End If

    Next i
    
    printArray3D (table)
    
End Sub

Answer 1

只需创建一个大小正确的临时文件并从原始文件中填充它。

Public Function ReDimPreserve3D(arr As Variant, newx As Long, newy As Long, newz As Long)
    Dim t() As Variant
    ReDim t(LBound(arr, 1) To newx, LBound(arr, 2) To newy, LBound(arr, 3) To newz)
    
    Dim i As Long
    For i = LBound(arr, 1) To Application.Min(UBound(arr, 1), UBound(t, 1))
          Dim j As Long
          For j = LBound(arr, 2) To Application.Min(UBound(arr, 2), UBound(t, 2))
            Dim k As Long
            For k = LBound(arr, 3) To Application.Min(UBound(arr, 3), UBound(t, 3))
                t(i, j, k) = arr(i, j, k)
            Next k
        Next j
    Next i

    ReDimPreserve3D = t
End Function