ArrayList in Array umwandeln und zurückgeben

Trash

Erfahrenes Mitglied
moin,
ich habe eine Funktion in VBA geschrieben, die mir in bestimmte Wörter in Form eines Arrays zurückliefern soll. Da ich die Anzahl der Wörter nicht kenne, würde ich eine ArrayList verwenden. Wenn ich allerdings die ArrayList in ein Array umforme und zurückgeben möchte, bekomme ich irgendwelche "unverträglichen Typen" zurück... In der objArrayList dürften eigentlich laut Debugger nur Strings sein.

Muss ich die objArrList irgendwie "casten"?

Code:
Private Function getLocationNames(location As String, length_of_location As Integer, length_of_left As Integer) As String()

'ArrayList
Dim objArrLst
Set objArrLst = CreateObject("System.collections.arraylist")
Dim arr() As String

.
. [weggelassen]
.


If foundSomething <> foundSomething_temp Then
objArrLst.Add foundSomething
End If

arr = objArrLst.ToArray
getLocationNames = arr
End Function

Danke!
 
Sehe ich das Richtig, du brauchst die ArrayList nur damit du ein flexibles Array hast, das du mir ADD erweitern kannst ohne das du jedesmal ein redim durchführen musst?

Eine kleine Funktionsammlung ermöglicht dir dieses relativ einfach mit dem normalen Array.

Visual Basic:
call pushArray(myArray, newValue)

Und hier meine Sammlung die ich eigentlich in jedem VB(A)-Projekt brache
Visual Basic:
'-------------------------------------------------------------------------------
'File         : ArrayFunctions
'               mpl © by ERB software
'               All rights reserved
'Environment  : Access 2000/XP, VB6
'Version      : 1.0
'Name         : Array Funktionen
'Description  : Diverse nützliche Funktionen zu Array's
'Author       : Stefan Erb (ERS)
'History      : 18.10.2004 - ERS - Creation
'-------------------------------------------------------------------------------

Option Explicit
Option Compare Database

'-------------------------------------------------------------------------------
' Public Methodes
'-------------------------------------------------------------------------------
'   /**
'    * IsEmptyArray
'    * prüft ob ein Array initializiert ist
'    * @param   Array
'    * @return  true if Array is not initialized
'    */
Public Function IsEmptyArray(ByVal iArray As Variant) As Boolean
  Dim Dummy As Long

  If IsArray(iArray) Then

    'Ggf. Fehler provozieren:
    On Error Resume Next
    Dummy = LBound(iArray)

    'Ergebnis bestimmen:
    IsEmptyArray = (Err.Number <> 0)
    On Error GoTo 0

  Else

    Err.Raise 13 'Type mismatch'

  End If
End Function

'   /**
'    * addArray
'    * Add Array2 to Array1
'    * @param   Array1
'    * @param   Array2
'    */
Public Sub addArray(ByRef ioArray As Variant, ByVal iArray As Variant)
    Dim i
    If Not IsEmptyArray(iArray) Then
        For i = 0 To UBound(iArray)
            Call pushArray(ioArray, iArray(i))
        Next i
    End If
    
End Sub

'   /**
'    * pushArray
'    * add Value to the Array
'    * @param   Array
'    * @param   Value
'    * @return  Ubound of the Array
'    */
Public Function pushArray(ByRef ioArray As Variant, ByVal iValue As Variant) As Long
  
  Call ReDimArray(ioArray:=ioArray, oUbound:=pushArray)
  ioArray(pushArray) = iValue

End Function

'   /**
'    * ArrayIndex
'    * search the index of a element in a array
'    * @param   element
'    * @param   array
'    * @return  index of the array
'    */
Public Function ArrayIndex( _
    ByRef iElement As Variant, _
    ByRef iArray As Variant _
  ) As Long

  If IsEmptyArray(iArray) Then
    ArrayIndex = -1
    Exit Function
  End If
  If IsObject(iElement) Then

    'Objekte vergleichen:
    For ArrayIndex = LBound(iArray) To UBound(iArray)
      If IsObject(iArray(ArrayIndex)) _
      Then If iElement Is iArray(ArrayIndex) _
           Then Exit Function
    Next ArrayIndex
   
  Else

    '"Normale" Werte vergleichen:
    For ArrayIndex = LBound(iArray) To UBound(iArray)
      If Not IsObject(iArray(ArrayIndex)) _
      Then If iElement = iArray(ArrayIndex) _
           Then Exit Function
    Next ArrayIndex

  End If

  'Kein Treffer:
  ArrayIndex = LBound(iArray) - 1
End Function

'   /**
'    * ReDimArray
'    * redim a array
'    * @param   array (ByRef)
'    * @param   step
'    * @param   Ubound of the Array
'    * @return  new array
'    */
Public Function ReDimArray( _
        ByRef ioArray As Variant, _
        Optional ByVal iStep As Long = 1, _
        Optional ByRef oUbound As Long) _
As Variant

  If IsEmptyArray(ioArray) Then
    ReDim ioArray(iStep - 1)
  ElseIf UBound(ioArray) + iStep > -1 Then
    ReDim Preserve ioArray(UBound(ioArray) + iStep)
  End If
  ReDimArray = ioArray
  oUbound = UBound(ioArray)

End Function

'   /**
'    * ArrayQuickSort
'    * sort the elements of a array
'       http://www.vbarchiv.net/archiv/tipp_details.php?pid=372
'    * @param   array (ByRef)
'    * @param   start
'    * @param   end
'    */
Public Sub ArrayQuickSort(ByRef ioArray As Variant, _
  Optional ByVal iStart As Variant, _
  Optional ByVal iEnd As Variant)

  ' Wird die Bereichsgrenze nicht angegeben,
  ' so wird das gesamte Array sortiert
  
  If IsMissing(iStart) Then iStart = LBound(ioArray)
  If IsMissing(iEnd) Then iEnd = UBound(ioArray)
  
  Dim i As Long
  Dim j As Long
  Dim h As Variant
  Dim x As Variant
  
  i = iStart: j = iEnd
  x = ioArray((iStart + iEnd) / 2)
  
  ' Array aufteilen
  Do
  
    While (ioArray(i) < x): i = i + 1: Wend
    While (ioArray(j) > x): j = j - 1: Wend
        
    If (i <= j) Then
      ' Wertepaare miteinander tauschen
      h = ioArray(i)
      ioArray(i) = ioArray(j)
      ioArray(j) = h
      i = i + 1: j = j - 1
    End If
  Loop Until (i > j)
  
  ' Rekursion (Funktion ruft sich selbst auf)
  If (iStart < j) Then ArrayQuickSort ioArray, iStart, j
  If (i < iEnd) Then ArrayQuickSort ioArray, i, iEnd
End Sub
 
Zurück