VBA TIPS
  Combining Arrays (including Get number of dimension from multi-dimensional arrays)

Since I had visited the Dick's blog, I have been thinking how to combine arrays including multi-dimensional arrays. But to do that, I need to know how many number of dimension the multi-dimensional array has. Finally I succeed to get number of dimension from multi-dimensional arrays using RtlMoveMemory routine.

Example

The following UDF returns an 1D array of variant type. Place the following in a standard module then execute the procedurenamed TestingFunction in step mode (by F8 key). As preparation, please input numbers in the worksheet like below.



Note, the arrays for passing to this UDF must be variant type if they are more than 2D array. But you can also pass not only arrays but also values to this UDF. For example, if a variable named arr has array like (1,2,3), this code arr = ArraysUnion(0, arr, 4, 5) returns an array as (0,1,2,3,4,5).

Download

You can download the sample workbook from here. sample_076.zip

Option Explicit

'Get a pointer to a dinamic array using RtlMoveMemory
Declare Sub RtlMoveMemory Lib "kernel32" ( _
                                          Destination As Any, _
                                          Source As Any, _
                                          ByVal Length As Long)

'Witten by Colo 5th Aug 2004
'Works in Excel 2000 and the later version

Sub TestingFunction()
    Dim buf0(1 To 3) As Long   '1D array
    Dim buf1 As Variant    '1D array
    Dim buf2 As Variant    '1D array
    Dim buf3 As Variant    '1D array
    Dim buf4 As Variant    '2D array  from Wks
    Dim buf5(1 To 2, 1 To 2, 1 To 2) As Variant    '3D array

    Dim ret As Variant    'an array for result
    Dim e As Variant    'for looping

    'Insert an array of Long type to an array
    buf0(1) = 1
    buf0(2) = 2
    buf0(3) = 3
    buf1 = ArraysUnion(0, buf0, 4, 5)

    'Insert an array of Variant type to an array
    buf2 = Array(9, 10, 11)
    buf2 = ArraysUnion(7, 8, buf2, 12)

    'Combine arrays
    buf3 = ArraysUnion(buf1, buf2)

    'Get 2D array from wks
    buf4 = [A1:C3].Value

    '3D array
    buf5(1, 1, 1) = 22
    buf5(2, 1, 1) = 23
    buf5(1, 2, 1) = 24
    buf5(2, 2, 1) = 25
    buf5(1, 1, 2) = 26
    buf5(2, 1, 2) = 27
    buf5(1, 2, 2) = 28
    buf5(2, 2, 2) = 29

    'Combine 4 arrays
    ret = ArraysUnion(buf3, buf4, buf5, Array(30, 31, 32, 33, 34, 35))

    'Result for the Function ArraysUnion
    For Each e In ret
        Debug.Print e
    Next
End Sub

Function ArraysUnion(ParamArray val() As VariantAs Variant
'Returns conbined an 1D array.
'The array must be Variant type
    Dim arr() As Variant
    Dim elm1 As Variant
    Dim elm2 As Variant
    Dim i As Long
    Dim cntElm As Long

    ReDim arr(LBound(val) To UBound(val))
    For Each elm1 In val
        If TypeName(elm1) Like "*()" Then
            cntElm = CountNumOfElement(elm1)
            ReDim Preserve arr(LBound(arr) To UBound(arr) + cntElm)
            For Each elm2 In elm1
                arr(i) = elm2
                i = i + 1
            Next
        Else
            arr(i) = elm1
            i = i + 1
        End If
    Next
    ArraysUnion = arr
End Function

Private Function GetNumberOfDim(ByRef vMultiDimArr As VariantAs Long
'Returns thenumber of dimensions of an array
    Dim i As Long
    Dim j As Long
    Dim k As Long
    'Check if the argument is an array
    If VarType(vMultiDimArr) & vbArray = 0 Then
        GetNumberOfDim = -1
        Exit Function
    End If
    RtlMoveMemory i, ByVal VarPtr(vMultiDimArr) + 8, 4
    RtlMoveMemory j, ByVal i, 4
    RtlMoveMemory k, ByVal j, 2    'Get Number of Dimensions
    GetNumberOfDim = k
End Function

Private Function CountNumOfElement(ByVal buf)
    Dim d As Long
    Dim i As Long
    Dim j As Long
    Dim ub As Long
    Dim lb As Long
    Dim DummyArr() As Variant    'It doesn't work in XL97
    If TypeName(buf) Like "Variant()" Then
        DummyArr = buf
        d = GetNumberOfDim(DummyArr)
    Else
        d = 1    
    End If
    j = 1
    For i = 1 To d
        lb = LBound(buf, i)
        ub = UBound(buf, i)
        j = j * (ub - lb + 1)
    Next
    CountNumOfElement = j - 1
End Function


| HOME |
Copyright © cellmasters.net - colo's junk room All Right Reserved
Tips and Information about Microsoft Excel|Masaru Kaji aka Colo