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.473
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

Copyright ©2000-2024 vb@rchiv Dieter OtterAlle Rechte vorbehalten.

Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.