Array von Arrays zurück geben

[HH]

Hallo zusammen,

mit der folgenden Funktion lese ich Daten aus einer Excel-Tabelle aus und speichere die Daten in einem Array von Arrays:

Code

	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

Code

 getData = resultArray 

eine Type missmatch Fehler.

Hat jemand eine Idee, woran das liegen könnte?

Gruß
Hubert

[Hatschi]

Hallo Hubert,

probier mal

Dim resultArray() As Variant

ohne die Klammern, also

Dim resultArray As Variant.

Bernd

[HH]

Hallo Bernd,

dann kracht es bei

Code

ReDim Preserve resultArray( rowArrayIndex )

Hab's auch schon mit ein List-Variablen versuch, also

Code

Dim resultList list As Variant

und

Code

resultList( CStr(rowArrayIndex) ) = columnValuesArray

Das bringt dann aber auch den Type missmatch bei der Zuweisung de Rückgabewertes:

Code

getDataAsList = resultList

Hubert

[Hatschi]

Hm und wenn du noch eine Hilfsvariable einlegst?

Code

Dim Hilfe as variant

und zum Ende statt

Code

getData = resultArray

Code

hilfe = resultArray
getData = hilfe

[ghostmw]

Hi,

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.

Code

if not isarray ( Variable ) then redim Variable( count ) else redim PRESERVE variable ( count )

Gruß
Marco

[ascabg]

Hallo,

@ghostmw,
Den Array hat er doch zu diesem Zeitpunkt schon.

Code

Dim resultArray() As Variant

Und er bekommt den Fehler ja bei getData = resultArray.
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

[ghostmw]

... nicht ganz, die erste Antwort bezog sich auf

dim result as Variant (also ohne die Klammern)

[HH]

Der Weg über eine Hilfsvariable und auch

Code

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:

Code

Class ExcelRowData
	Public columnValues As Variant
End Class

Die nutze ich dann wie folgt:

Code

	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

Code

	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

Code

	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

[jBubbleBoy]

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:

Code

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

[HH]

Guter Tipp! Danke.

Hubert