transponieren per VBA

15/08/2010 - 18:40 von Stefan Paesch | Report spam
Moin zusammen,

zum Filtern in einem Buchhaltungsprogramm benötige ich einen String (Komma
getrennt) in einer Zelle:
wert1,wert2,wert3,wert4

Die Werte stehen in einer Exceltabelle untereinander (stammen aus einer
anderen Auswertung, kann nicht geàndert werden):
wert1
wert2
wert3
wert4

Hat jemand dafür einen Code auf "Lager" und kann mir diesen zur Verfügung
stellen.
Ich habe momentan eine Lösung auf Access-Basis, wobai das Access auf "die
Exceldatei" zugreift.
Das natürlich Mumpitz, aber ich habe von Excel-VBA überhaupt keinen Plan.

Office2007 SP2; Vista Ultimate 64 bit
 

Lesen sie die antworten

#1 Andreas Killer
15/08/2010 - 20:32 | Warnen spam
Am 15.08.2010 18:40, schrieb Stefan Paesch:

zum Filtern in einem Buchhaltungsprogramm benötige ich einen String (Komma getrennt) in einer Zelle:
wert1,wert2,wert3,wert4

Die Werte stehen in einer Exceltabelle untereinander (stammen aus einer anderen Auswertung, kann nicht geàndert werden):
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

Ähnliche fragen