Hallo zusammen,
mit der folgenden Funktion lese ich Daten aus einer Excel-Tabelle aus und speichere die Daten in einem Array von Arrays:
Function getData( xlSheet As Variant, columnCount As Integer ) As Variant
If columnCount = 1 Then
Print "Abbruch, Spaltenanzahl = 0"
Exit Function
End If
On Error GoTo fehler
Dim i As Integer
Dim currentRow As Integer
currentRow = m_titleRowNumber + 1
Dim currentColumn As Integer
currentColumn = 1
Dim rowArrayIndex As Integer
rowArrayIndex = 0
Dim columnArrayIndex As Integer
columnArrayIndex = 0
Dim resultArray() As Variant
Dim cellValue As String
'Print "currentRow = " & currentRow & ", cancelColumnNumber = " & m_cancelColumnNumber
cellValue = xlSheet.cells( currentRow, m_cancelColumnNumber ).value
Do While cellValue <> ""
Print "lese Daten, Zeile " & currentRow
ReDim Preserve resultArray( rowArrayIndex )
Dim columnValuesArray() As string
'Print "columnCount = " & columnCount
redim columnValuesArray( 0 To columnCount -1 )
columnArrayIndex = 0
For i = 0 To columnCount -1
columnValuesArray(i) = xlSheet.cells( currentRow, i+1 ).value
Next
resultArray( rowArrayIndex) = columnValuesArray
rowArrayIndex = rowArrayIndex + 1
currentRow = currentRow + 1
cellValue = xlSheet.cells( currentRow, m_cancelColumnNumber ).value
Loop
For i = 0 To UBound( resultArray )
Print i & " = " & Join( resultArray(i), "~" )
Next
Stop
getData = resultArray
weiter:
Exit Function
fehler:
MsgBox Error & Chr(13) & "Zeile: " & Erl & Chr(13) & "Nr.: " & Err & Chr(13) & "Modul: " & "getData", 16, "Fehler"
Resume weiter
End Function
Das läuft alles wie gewünscht. Die Daten werden eingelesen und in der Testschleife auch ausgegeben. Allerdings wirft die Zeile eine Type missmatch Fehler.
Hat jemand eine Idee, woran das liegen könnte?
Gruß
Hubert
Hallo Bernd,
dann kracht es bei
ReDim Preserve resultArray( rowArrayIndex )
Hab's auch schon mit ein List-Variablen versuch, also
Dim resultList list As Variant
und
resultList( CStr(rowArrayIndex) ) = columnValuesArray
Das bringt dann aber auch den Type missmatch bei der Zuweisung de Rückgabewertes:
getDataAsList = resultList
Hubert
Hm und wenn du noch eine Hilfsvariable einlegst?
und zum Ende statt
hilfe = resultArray
getData = hilfe
ich denke die Lösung, die dir zuerst genannt wurde, ist gut und nur die halbe "Miete".
Du musst natürlich an der Stelle vor dem Redim preserve erstmal ein Array haben, also eine Abfrage reinmachen.
if not isarray ( Variable ) then redim Variable( count ) else redim PRESERVE variable ( count )
Gruß
Marco
Hallo,
@ghostmw,
Den Array hat er doch zu diesem Zeitpunkt schon.
Dim resultArray() As Variant
Und da ist der Array doch schon erfolgreich geschrieben.
Was ich mich aber gerade frage ist, ist es überhaupt möglich mehrdimensionale Arrays als
Rückgabewert einer Funktion zu haben.
Andreas
Der Weg über eine Hilfsvariable und auch
If Not IsArray ( resultArray ) Then ReDim resultArray( rowArrayIndex ) Else ReDim Preserve resultArray ( rowArrayIndex )
bringen leider weiterhin den Type missmatch.
Abär:
Da ich sonst schon des öfteren mit Arrays von Objekten gearbeitet habe, habe ich mir für den die Excel-Row eine eigene, simple Klasse erstellt:
Class ExcelRowData
Public columnValues As Variant
End Class
Die nutze ich dann wie folgt:
Function getData( xlSheet As Variant, columnCount As Integer ) As Variant
If columnCount = 1 Then
Print "Abbruch, Spaltenanzahl = 0"
Exit Function
End If
On Error GoTo fehler
Dim i As Integer
Dim currentRow As Integer
currentRow = m_titleRowNumber + 1
Dim currentColumn As Integer
currentColumn = 1
Dim rowArrayIndex As Integer
rowArrayIndex = 0
Dim columnArrayIndex As Integer
columnArrayIndex = 0
Dim resultArray() As Variant
Dim cellValue As String
cellValue = xlSheet.cells( currentRow, m_cancelColumnNumber ).value
Do While cellValue <> ""
ReDim Preserve resultArray( rowArrayIndex )
'hier weise ich dem Array Element das ExcelRowData Objekt zu
Set resultArray( rowArrayIndex) = me.getColumnDataAsObject(xlSheet, Currentrow, Columncount)
rowArrayIndex = rowArrayIndex + 1
currentRow = currentRow + 1
cellValue = xlSheet.cells( currentRow, m_cancelColumnNumber ).value
Loop
For i = 0 To UBound( resultArray )
Dim rowDataObject As New ExcelRowData
Set rowDataObject = resultArray(i)
Print i & " = " & Join( rowDataObject.columnValues , "~" )
Next
Stop
getData = resultArray
weiter:
Exit Function
fehler:
MsgBox Error & Chr(13) & "Zeile: " & Erl & Chr(13) & "Nr.: " & Err & Chr(13) & "Modul: " & "getData", 16, "Fehler"
Resume weiter
End Function
Function getColumnDataAsObject( xlSheet As Variant, currentRow As Integer, columnCount As Integer ) As excelRowData
On Error GoTo fehler
Dim colDataObject As New ExcelRowData
colDataObject.columnValues = getColumnDataArray( xlSheet, currentRow, columnCount )
Set getColumnDataAsObject = colDataObject
weiter:
Exit Function
fehler:
MsgBox Error & Chr(13) & "Zeile: " & Erl & Chr(13) & "Nr.: " & Err & Chr(13) & "Modul: " & "getColumnDataArray", 16, "Fehler"
Resume weiter
End Function
Function getColumnDataArray( xlSheet As Variant, currentRow As Integer, columnCount As Integer ) As Variant
On Error GoTo fehler
Dim columnValuesArray() As String
Dim columnArrayIndex As Integer
Dim i As Integer
'Print "columnCount = " & columnCount
ReDim columnValuesArray( 0 To columnCount -1 )
columnArrayIndex = 0
For i = 0 To columnCount -1
columnValuesArray(i) = xlSheet.cells( currentRow, i+1 ).value
Next
getColumnDataArray = columnValuesArray
weiter:
Exit Function
fehler:
MsgBox Error & Chr(13) & "Zeile: " & Erl & Chr(13) & "Nr.: " & Err & Chr(13) & "Modul: " & "getColumnDataArray", 16, "Fehler"
Resume weiter
End Function
Also folgere ich: Array von Arrays geht nicht als Rückgabewert einer Funktion bzw. Methode, Array von (eigenen) Objekten funktioniert. Oder ziehe ich die falschen Schlüsse?
Danke für die Antworten!
Gruß
Hubert
Mit Hilfe einer Array-Klasse lässt sich das lösen. Die Array-Klasse hat auch den Vorteil das der Code übersichtlicher wird. Die Array-Klasse bitte nach eigenem Bedarf erweitern, hier nur ein minimales und funktionierendes Beispiel:
Class dnArray
ar() As Variant
index As Integer
Sub New
ReDim ar(0)
End Sub
Sub addValue(v As Variant)
ReDim Preserve ar(index)
If TypeName(v) = "DNARRAY" Then
Set ar(index) = v
else
ar(index) = v
End If
index = index + 1
End Sub
Function getArray As Variant
getArray = ar
End Function
End Class
Sub Initialize
On Error GoTo errorz
Dim array As dnArray
Dim inneresArray As dnArray
Set array = getData
ForAll x In array.getArray
Set inneresArray = x
ForAll y In inneresArray.getArray
Print y
End ForAll
End ForAll
GoTo endeZ
errorZ:
Print "Ein Fehler in " & GetThreadInfo(1) & " Zeile:" & Erl & " Code:" & Err & " Text:" & Error
Resume endez
endeZ:
End Sub
Function getData() As dnArray
On Error GoTo errorz
Dim a1 As new dnArray
Dim a2 As New dnArray
Dim a3 As New dnArray
Call a2.addValue(1)
Call a2.addValue(2)
Call a2.addValue(3)
Call a3.addValue(15)
Call a1.addValue(a2)
Call a1.addValue(a3)
Set getData = a1
GoTo endeZ
errorZ:
Print "Ein Fehler in " & GetThreadInfo(1) & " Zeile:" & Erl & " Code:" & Err & " Text:" & Error
Resume endez
endeZ:
End Function