Excel VBA - How to Redim a 2D array?

前端 未结 9 2063
闹比i
闹比i 2020-11-30 06:57

In Excel via Visual Basic, I am iterating through a CSV file of invoices that is loaded into Excel. The invoices are in a determinable pattern by client.

I am readin

相关标签:
9条回答
  • 2020-11-30 07:30

    I know this is a bit old but I think there might be a much simpler solution that requires no additional coding:

    Instead of transposing, redimming and transposing again, and if we talk about a two dimensional array, why not just store the values transposed to begin with. In that case redim preserve actually increases the right (second) dimension from the start. Or in other words, to visualise it, why not store in two rows instead of two columns if only the nr of columns can be increased with redim preserve.

    the indexes would than be 00-01, 01-11, 02-12, 03-13, 04-14, 05-15 ... 0 25-1 25 etcetera instead of 00-01, 10-11, 20-21, 30-31, 40-41 etcetera.

    As only the second (or last) dimension can be preserved while redimming, one could maybe argue that this is how arrays are supposed to be used to begin with. I have not seen this solution anywhere so maybe I'm overlooking something?

    0 讨论(0)
  • 2020-11-30 07:32

    here is updated code of the redim preseve method with variabel declaration, hope @Control Freak is fine with it:)

    Option explicit
    'redim preserve both dimensions for a multidimension array *ONLY
    Public Function ReDimPreserve(aArrayToPreserve As Variant, nNewFirstUBound As Variant, nNewLastUBound As Variant) As Variant
        Dim nFirst As Long
        Dim nLast As Long
        Dim nOldFirstUBound As Long
        Dim nOldLastUBound As Long
    
        ReDimPreserve = False
        'check if its in array first
        If IsArray(aArrayToPreserve) Then
            'create new array
            ReDim aPreservedArray(nNewFirstUBound, nNewLastUBound)
            'get old lBound/uBound
            nOldFirstUBound = UBound(aArrayToPreserve, 1)
            nOldLastUBound = UBound(aArrayToPreserve, 2)
            'loop through first
            For nFirst = LBound(aArrayToPreserve, 1) To nNewFirstUBound
                For nLast = LBound(aArrayToPreserve, 2) To nNewLastUBound
                    'if its in range, then append to new array the same way
                    If nOldFirstUBound >= nFirst And nOldLastUBound >= nLast Then
                        aPreservedArray(nFirst, nLast) = aArrayToPreserve(nFirst, nLast)
                    End If
                Next
            Next
            'return the array redimmed
            If IsArray(aPreservedArray) Then ReDimPreserve = aPreservedArray
        End If
    End Function
    
    0 讨论(0)
  • 2020-11-30 07:32

    You could do this array(0)= array(0,1,2,3).

    Sub add_new(data_array() As Variant, new_data() As Variant)
        Dim ar2() As Variant, fl As Integer
        If Not (isEmpty(data_array)) = True Then
            fl = 0
        Else
            fl = UBound(data_array) + 1
        End If
        ReDim Preserve data_array(fl)
        data_array(fl) = new_data
    End Sub
    
    Sub demo()
        Dim dt() As Variant, nw(0, 1) As Variant
        nw(0, 0) = "Hi"
        nw(0, 1) = "Bye"
        Call add_new(dt, nw)
        nw(0, 0) = "Good"
        nw(0, 1) = "Bad"
        Call add_new(dt, nw)
    End Sub
    
    0 讨论(0)
提交回复
热议问题