excel - ReDim 保留 3D VBA

Question

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

上下文:这都是通过以 3 个分隔符分割来将类似于 CSV 的文件转换为 Excel 表的尝试的一部分: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