Rubrik: Variablen/Strings · Arrays | VB-Versionen: VB6 | 11.09.08 |
VariantArray von 1- nach 2- dim.Array konvertieren Diese Funktion konvertiert ein 1-dimensionales Array in ein 2-dimensionales Array | ||
Autor: Norbert Grimm | Bewertung: | Views: 11.474 |
ohne Homepage | System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | kein Beispielprojekt |
Die Funktion ConvArray2Dim konvertiert ein 1-dimensionales Array in ein 2-dimensionales Array.
vArray muss mit "ReDim" erstellt(definiert) sein!
Der Inhalt des 1-dim.Array's wird in ein temp.2-dim.Array eingelesen. Das übergebene 1-dim.Array wird dann gelöscht und als 2-dim.Array redimensioniert. Die Daten werden aus dem temp.2-dim.Array eingelesen.
Diese Funktion findet Verwendung als vorgeschaltene Funktion für andere Funktionen/Prozeduren, die ein 2-dim.Array als Übergabeparameter benötigen (siehe z.B. Sort_Funktionen).
Function ConvArray2Dim(ByRef vArray() As Variant) As Long Dim iTyp As Integer Dim I As Long Dim nErr As Long Dim Ret As Long Dim LB1 As Long Dim UB1 As Long Dim UB2 As Long Dim vArr2() As Variant ' prüfe Datentyp iTyp = VarType(vArray) If iTyp = (vbVariant + vbArray) Then ' Variant_Array ' Fehlerroutine mit Resume On Error Resume Next UB1 = UBound(vArray, 1) ' prüfe 1.Dimension With Err If .Number <> 0 Then ' Err: 9 nErr = .Number End If End With If nErr Then ' Err: 9 Ret = nErr GoTo Exit_CA2D ' beende über Exit_CA2D End If LB1 = LBound(vArray, 1) UB2 = UBound(vArray, 2) ' prüfe 2.Dimension With Err If .Number <> 0 Then ' Err: 9 nErr = .Number .Clear End If End With If nErr Then ' Err: 9 Ret = nErr ' nicht dimensioniert ' Fehlerroutine On Error GoTo Err_CA2D ReDim vArr2(LB1 To UB1, 1) ' dimensioniere 2-dim-Variant_Array(temp) For I = LB1 To UB1 ' einlesen vArray in vVar vArr2(I, 0) = I vArr2(I, 1) = vArray(I) Next I ReDim vArray(LB1 To UB1, 1) ' redimensioniere vArray For I = LB1 To UB1 ' einlesen vArray in vArr2 vArray(I, 0) = vArr2(I, 0) vArray(I, 1) = vArr2(I, 1) Next I Erase vArr2 ' lösche temp.Array Ret = 0 End If Else Ret = iTyp End If ' Ret = 0 , o.k. ' <> 0 , Fehler bzw. kein Variant_Array Exit_CA2D: ConvArray2Dim = Ret Exit Function Err_CA2D: With Err Ret = .Number .Clear End With Resume Exit_CA2D End Function