VBA – Array transponieren
In diesem Tutorial lernen Sie, wie Sie ein Array mit VBA transponieren können.
Array transponieren
Diese Funktion wird ein 2-dimensionales Array transponieren:
Function ArrayTransponieren(MeinArray As Variant) As Variant
Dim x As Long, y As Long
Dim maxX As Long, minX As Long
Dim maxY As Long, minY As Long
Dim tempArr As Variant
'Obere und untere Grenzen ermitteln
maxX = UBound(MeinArray, 1)
minX = LBound(MeinArray, 1)
maxY = UBound(MeinArray, 2)
minY = LBound(MeinArray, 2)
'Neues Temporäres Array erstellen
ReDim tempArr(minY To maxY, minX To maxX)
'Das Array transponieren
For x = minX To maxX
For y = minY To maxY
tempArr(y, x) = MeinArray(x, y)
Next y
Next x
'Array ausgeben
ArrayTransponieren = tempArr
End Function
Sub ArrayTransponierenTest()
Dim testArr(1 To 3, 1 To 2) As Variant
Dim AusgabeArr As Variant
'Array-Werte zuweisen
testArr(1, 1) = "Steve"
testArr(1, 2) = "Johnson"
testArr(2, 1) = "Ryan"
testArr(2, 2) = "Johnson"
testArr(3, 1) = "Andreas"
testArr(3, 2) = "Scott"
'Transponierfunktion aufrufen
AusgabeArr = ArrayTransponieren(testArr)
'Testausgabe
MsgBox AusgabeArr(2, 1)
End Sub
Um diese Funktion zu testen, rufen Sie die Prozedur ArrayTransponierenTest auf. Hier wird ein Anfangs-Array namens testArr erstellt und AusgabeArr ist das endgültige transponierte Array.
WorksheetFunction.Transpose
Stattdessen möchten Sie vielleicht ein Array in Excel transponieren. Dazu können Sie die Excel-Arbeitsblattfunktion Tanspose verwenden.
Diese Prozedur transponiert ein 2D-Array in einen Excel-Bereich unter Verwendung der Arbeitsblattfunktion Transpose:
Sub TestArrayTransponieren_ArbeitsblattFX()
Dim maxX As Long, minX As Long
Dim maxY As Long, minY As Long
'Array erstellen und Werte zuweisen
Dim MeinArray(1 To 3, 1 To 2) As Variant
MeinArray(1, 1) = "Steve"
MeinArray(1, 2) = "Johnson"
MeinArray(2, 1) = "Ryan"
MeinArray(2, 2) = "Johnson"
MeinArray(3, 1) = "Andreas"
MeinArray(3, 2) = "Scott"
'Obere und untere Grenzen ermitteln
maxX = UBound(MeinArray, 1)
minX = LBound(MeinArray, 1)
maxY = UBound(MeinArray, 2)
minY = LBound(MeinArray, 2)
'Array nach Excel transponieren
Range("a1").Resize(maxY - minY + 1, maxX - minX + 1).Value = _
Application.WorksheetFunction.Transpose(MeinArray)
End Sub