2-dimensional array

Prøv engang at kigge på denne kode, og se om du efterfølgende kan få hul igennem din egen kode...

Sub ArrayDemo()
    Dim aSource As Variant, aTarget As Variant
    Dim iLastTarget As Integer, iNewMax As Integer
    Dim x As Integer, y As Integer
   
    ' Opret et target array 3,2 med indhold
    ReDim aTarget(1 To 3, 1 To 2)
    aTarget(1, 1) = "Allan"
    aTarget(1, 2) = "1"
    aTarget(2, 1) = "Bente"
    aTarget(2, 2) = "2"
    aTarget(3, 1) = "Casper"
    aTarget(3, 2) = "3"
   
    ' Opret et source array 1,2 med indhold
    ReDim aSource(1 To 1, 1 To 2)
    aSource(1, 1) = "Doris"
    aSource(1, 2) = "4"
   
    ' Udvid target array så alt fra source array kan fyldes deri
    iLastTarget = UBound(aTarget, 1)
    iNewMax = iLastTarget + UBound(aSource, 1)
   
    ' Et to demintionelt array kan ikke udvides i første demintion, men kun i den anden,
    ' derfor må array'et vendes rundt, udvides og vendes tilbage igen
    aTarget = TransposeArray(aTarget) ' byt om
    ReDim Preserve aTarget(1 To 2, 1 To iNewMax) ' udvid
    aTarget = TransposeArray(aTarget) ' byt retur
   
    ' Indsæt nye værdier
    For x = LBound(aSource, 1) To UBound(aSource, 1)
        For y = LBound(aSource, 2) To UBound(aSource, 2)
            aTarget(iLastTarget + x, y) = aSource(x, y)
        Next y
    Next
       
    'Indsæt værdier i aktivt ark
    ActiveSheet.Range("A1").Resize(UBound(aTarget, 1), UBound(aTarget, 2)).Value = aTarget
   
End Sub


Public Function TransposeArray(ByVal aSource As Variant) As Variant
    Dim aRetVal As Variant
    Dim lRow As Long, lCol As Long

    ReDim aRetVal(LBound(aSource, 2) To UBound(aSource, 2), LBound(aSource, 1) To UBound(aSource, 1))
    For lRow = LBound(aSource, 1) To UBound(aSource, 1)
        For lCol = LBound(aSource, 2) To UBound(aSource, 2)
            aRetVal(lCol, lRow) = aSource(lRow, lCol)
        Next lCol
    Next lRow

    TransposeArray = aRetVal
End Function