简体   繁体   中英

Excel-VBA creating a 3d array from 3 1d arrays

I have 3 one dimensional Arrays namely Topic(), SubTopic() and Description() . The Maximum number of entries in each of These Arrays is limited by a variable noDescription . I Need to make a 3d Array out of These Arrays and Display it. My code is :

 ReDim info(1 To Topic(), 1 To SubTopic(), 1 To Description())

  p = 1
  Do

  info(p, 0, 0) = Topic(p)
  info(p, 1, 0) = SubTopic(p)
  info(p, 0, 2) = Description(p)

  MsgBox "array value" & info(p, 0, 0) & "and" & info(p, 1, 0) & "and" & info(p, 0, 2)

   p = p + 1

Loop Until p > noDescription

It gives a type mismatch error on Dimensioning the Array. I feel I am wrong somewhere. Any help ?

Here is a function which can be used to glue together any number of 1-dimensional arrays:

Function CombineArrays(ParamArray Arrays() As Variant) As Variant
    'Takes a list of 1-dimensional arrays
    'And returns a single array
    'The arrays are assumed to have the same base
    'But not necessarily the same length
    'The arrays form the columns of the result

    Dim A As Variant
    Dim i As Long, j As Long, lb As Long, ub As Long, m As Long

    'first find LBound -- assumed to be common

    lb = LBound(Arrays(0))

    'now find the maximum ubound:

    For i = LBound(Arrays) To UBound(Arrays)
        If UBound(Arrays(i)) > ub Then ub = UBound(Arrays(i))
    Next i

    'now redim and return final array

    m = lb + UBound(Arrays)
    ReDim A(lb To ub, lb To m)

    For j = lb To m
        For i = lb To UBound(Arrays(j - lb))
            A(i, j) = Arrays(j - lb)(i)
        Next i
    Next j
    CombineArrays = A
End Function

Tested like:

Sub Test()
    Dim Larry(1 To 4)
    Dim Curly(1 To 2)
    Dim Moe(1 To 3)
    Dim A As Variant

    Larry(1) = 1
    Larry(2) = 2
    Larry(3) = 3
    Larry(4) = 4
    Curly(1) = "A"
    Curly(2) = "B"
    Moe(1) = "X"
    Moe(2) = "Y"
    Moe(3) = "Z"

    A = CombineArrays(Larry, Curly, Moe)
    Range("A1:C4").Value = A
End Sub

After running the sub, A1:C4 looks like:

1   A   X
2   B   Y
3       Z
4       

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM