transponieren per VBA

[Stefan Paesch]

Vielen Dank Stefan.

[Andreas Killer]

wert1,wert2,wert3,wert4
wert1
wert2
wert3
wert4

Einen sollchen String kannt man gut mit VBA.Join zusammenbauen, leider unterstützt es keine 2dimensionalen Array's,
welche man leider bekommt wenn man Daten aus einer Tabelle einliest.

Ich gehe davon aus das die Werte in Zelle A1 bis A4 stehen, kannst beliebig anpassen, solange es ein zusammenhängender
Bereich ist.

Andreas.

Option Explicit

Sub Test()
Dim S As String
S = MultiJoin(Range("A1:A4"), ",", ",")
Debug.Print S
End Sub

Private Function Dimension(Arr As Variant) As Long
'Returns number of dimensions of an array or 0 for an _
undimensioned array or -1 if no array at all.
If IsArray(Arr) Then
On Error GoTo Done
Do
Dimension = Dimension + 1
Loop While IsNumeric(UBound(Arr, Dimension))
End If
Done:
Dimension = Dimension - 1
End Function

Function MultiJoin(SourceArray, _
Optional ByVal Delimiter As String = " ", _
Optional ByVal EndOfLine As String = vbCrLf) As String
'Wie Join, jedoch auch für 2dimensionale Datenfelder
Dim I As Long, J As Long, Data
'In Excel müssen wir einen Range einlesen!
Data = SourceArray
Select Case Dimension(Data)
Case -1 To 0
MultiJoin = Data
Case 1
MultiJoin = Join(Data, Delimiter)
Case 2
'Fehlerwerte werden nicht hinzugefügt!
On Error Resume Next
'String zusammensetzen, Trenner nur zwischen den Elementen
For I = LBound(Data) To UBound(Data) - 1
For J = LBound(Data, 2) To UBound(Data, 2) - 1
MultiJoin = MultiJoin & Data(I, J) & Delimiter
Next
MultiJoin = MultiJoin & Data(I, J) & EndOfLine
Next
For J = LBound(Data, 2) To UBound(Data, 2) - 1
MultiJoin = MultiJoin & Data(I, J) & Delimiter
Next
MultiJoin = MultiJoin & Data(I, J)
Case Else
Err.Raise 5, "MultiJoin", "Anzahl Dimensionen " & _
"SourceArray zu groß"
End Select
End Function

[Peter Schleif]

Post by Andreas Killer
Einen sollchen String kannt man gut mit VBA.Join zusammenbauen, leider
unterstützt es keine 2dimensionalen Array's, welche man leider bekommt
wenn man Daten aus einer Tabelle einliest.

'eine Spalte
MsgBox Join(WorksheetFunction.Transpose([A1:A4]), ",")

'eine Zeile
MsgBox Join(WorksheetFunction.Transpose( _
WorksheetFunction.Transpose([A1:D1])), ",")

'zweite Spalte aus einem mehrzeiligen und -spaltigen Bereich
MsgBox Join(WorksheetFunction.Transpose( _
WorksheetFunction.Index([A1:D4], 0, 2)), ",")

'dritte Zeile aus einem mehrzeiligen und -spaltigen Bereich
MsgBox Join(WorksheetFunction.Transpose( _
WorksheetFunction.Transpose( _
WorksheetFunction.Index([A1:D4], 3, 0))), ",")

Natürlich kann man die ersten beiden auch als Spezialfall der zweiten
beiden auffassen.

Peter

[Andreas Killer]

Post by Peter Schleif

Post by Andreas Killer
Einen sollchen String kannt man gut mit VBA.Join zusammenbauen, leider
unterstützt es keine 2dimensionalen Array's, welche man leider bekommt
wenn man Daten aus einer Tabelle einliest.

'eine Spalte
MsgBox Join(WorksheetFunction.Transpose([A1:A4]), ",")

Jipp, das ist schick, keine Frage, funktioniert aber nur wenn man ein WorksheetFunction-Object hat.

Ohne Excel ist die Zauberei damit vorbei. Hui, das reimt sich. :-))

Ich hab das auch früher in meinen Codes benutzt, bis ich dann zum ersten Mal was für Solidworks Stand-Alone brauchte.

Daher lass ich das jetzt lieber weg und so funzt es immer und überall. :-)

Andreas.

[Peter Schleif]

[...] funktioniert aber nur wenn man ein WorksheetFunction-Object hat.

Häääh? Warum sollte man kein WorksheetFunction-Object haben, wenn man
mit Excel arbeitet?

Ohne Excel ist die Zauberei damit vorbei. Hui, das reimt sich. :-))

Der OP stellt in einer Excel-Gruppe eine Frage zu einer Excel-Tabelle.
Also dürfen wir wohl davon ausgehen, dass Excel installiert ist. Dann
hat man aber auch Zugriff auf Excel's WorksheetFunctions. Direkt in
Excel sowieso und wenn man von anderen Anwendungen aus auf Excel
zugreift hat man wohl i.d.R. ein Application-Object, dem
WorksheetFunction bekanntlich unterstellt ist. Hier ein Beispiel mit
VB-Script.

Peter

'-------------------- WorksheetFunction.vbs --------------------
Option Explicit

Call WorksheetFunction

Sub WorksheetFunction()
Dim app 'As Object

Set app = CreateObject("Excel.Application")

With app.Workbooks.Add.Worksheets.Add
.Range("A1:A4").Formula = "=ROW()"
MsgBox Join(app.WorksheetFunction.Transpose(.Range("A1:A4")), ",")
End With
End Sub

[Andreas Killer]

[...] funktioniert aber nur wenn man ein WorksheetFunction-Object hat.

Häääh? Warum sollte man kein WorksheetFunction-Object haben, wenn man mit Excel arbeitet?

Ja, ist ja alles richtig was Du sagst.

Ich wollt nur meine Erfahrung weitergeben, bei manchen Routinen sollte man sich es sich überlegen ob man sie nicht
vielleicht an anderer Stelle gebrauchen kann und dort könnte es durchaus sein das dann plötzlich mal kein Excel mehr da
ist, sondern z.B. Open Office.

Im Endeffekt ist's doch wurscht, Hauptsache es geht.

Andreas.

[Michael Schwimmer]

Hallo Stefan,

zum Filtern in einem Buchhaltungsprogramm benötige ich einen String (Komma
wert1,wert2,wert3,wert4
Die Werte stehen in einer Exceltabelle untereinander (stammen aus einer
wert1
wert2
wert3
wert4
Hat jemand dafür einen Code auf "Lager" und kann mir diesen zur Verfügung
stellen.

erst einmal zur Info:
Diese NG wurde vor einiger Zeit von Microsoft aufgelöst, deine Postings
kommen also nur noch an, weil einige Newsserverbetreiber die NG noch nicht
gelöscht haben. Microsoft unterstützt momentan nur noch eigene Webforen.

Inzwischen ist im Usenet eine entsprechende Newsgroup unter
de.comp.office-pakete.ms-office.excel eingerichtet worden.

Zu deinem Problem:
Neben dem noch am leichtesten umzusetzenden Vorschlag von Andreas könnte
man auch noch einen Bereich in ein Array 'beamen' und anschließend die
Safearraystruktur so manipulieren, dass man nachher ein eindimensionales
Array hat. Dann kann man auch mit Join arbeiten. Da man dabei
Speicherbereiche direkt manipuliert, ist die Sache nicht ganz einfach und
ich würde einem Unerfahrenen davon abraten.

Eine weitere Option ist die Verwendung von ADO:

Public Sub JoinEx()
Dim adoConnection As Object
Dim adoRecordset As Object
Dim strResult As String
Dim strSheet As String
Dim strSQL As String
Dim strColDelimiter As String
Dim strRowDelimiter As String
Dim strBereich As String
Dim strHeader As String
Dim strNullExpr As String
Dim blnHeader As Boolean
Const adOpenKeyset As Long = 1
Const adLockOptimistic As Long = 3
Const adClipString As Long = 2

' Trennzeichen
strColDelimiter = ","
strRowDelimiter = ","

' Name des Arbeitsblattes
strSheet = "Tabelle1"

' Quellbereich
strBereich = "A1:A8"

' Zeichenfolge für leere Felder
strNullExpr = "#NV"

' Header nicht vorhanden
blnHeader = False

strHeader = "HDR=" & IIf(blnHeader, "Yes", "No") & ";"

Set adoConnection = CreateObject("ADODB.Connection")
Set adoRecordset = CreateObject("ADODB.Recordset")

' Verbinden mit eigener Datei
adoConnection.Open _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.FullName & _
";Extended Properties=""Excel 8.0;" & _
strHeader & """"

' Vom Blatt strSheet in den Recordset
strSQL = "SELECT * FROM [" & strSheet & "$" & strBereich & "];"

adoRecordset.Open _
strSQL, _
adoConnection, _
adOpenKeyset, _
adLockOptimistic

strResult = adoRecordset.GetString( _
adClipString, , strColDelimiter, strRowDelimiter, strNullExpr)

' strResult = Left(strResult, Len(strResult) - 1)

' Schließen
adoRecordset.Close
adoConnection.Close

MsgBox strResult

End Sub

Da du die Daten ja untereinander stehen hast, ist hier der Zeilentrenner
strRowDelimiter das Trennzeichen zwischen den Werten.

Viele Grüße
Michael

[Stefan Paesch]

Hallo Andreas, hallo Michael,

vielen Dank für Eure schnelle Antwort.
Wie ich es mir gedacht habe, ist es nicht so trivial .....

Also vielen vielen Dank Stefan.

[Peter Schleif]

Post by Stefan Paesch
Wie ich es mir gedacht habe, ist es nicht so trivial .....

Es ist _eine_ Zeile!

Peter

[Peter Schleif]

zum Filtern in einem Buchhaltungsprogramm benötige ich einen String
wert1,wert2,wert3,wert4

MsgBox Join(WorksheetFunction.Transpose( _
Range([A1], Cells(Rows.Count, "A").End(xlUp))), ",")

Peter

[Michael Schwimmer]

Hallo Peter,

Post by Peter Schleif
MsgBox Join(WorksheetFunction.Transpose( _
Range([A1], Cells(Rows.Count, "A").End(xlUp))), ",")

eine Zeile, das ist doch viel zu einfach! ;-)

Im Ernst, wer hätte gedacht, dass Transpose nicht nur die Dimensionen
vertauscht, sondern auch aus einem zweidimensionalen Array ein
eindimensionales macht, wenn eine Dimension nur ein Element besitzt.

Wieder was dazugelernt, Danke!

Viele Grüße
Michael