AW: Zellen Inhalt zerlegen
10.03.2010 11:15:16
Heiko
Hallo Martin,
wenn alle Daten so aufgebaut sind wie dein Beispiel, dann sollte folgender Code helfen:
Bitte auch die Optionen mit kopieren.
Ich habe vorausgesetzt die daten stehen in einer Tabelle in der Spalte A, und die zerlegten Daten werden dann in B,C ... eingetragen.
Option Explicit
Option Base 1
Sub Zerlegen()
Dim lngI As Long, lngArray As Long, lngSpalte As Long
Dim strhelp As String
Dim arrDaten
For lngI = 1 To ActiveSheet.Cells(65535, 1).End(xlUp).Row
strhelp = ""
lngSpalte = 2
arrDaten = Split(ActiveSheet.Cells(lngI, 1), " ")
For lngArray = LBound(arrDaten) To UBound(arrDaten)
Select Case lngSpalte
Case 2
' Text vor "K", "G" oder "K/G" und "K", "G" oder "K/G" selbst
If arrDaten(lngArray) = "K" Or arrDaten(lngArray) = "G" Or arrDaten(lngArray) = _
"K/G" Then
ActiveSheet.Cells(lngI, lngSpalte) = strhelp
ActiveSheet.Cells(lngI, lngSpalte + 1) = arrDaten(lngArray)
lngSpalte = lngSpalte + 1
strhelp = ""
Else
strhelp = strhelp & arrDaten(lngArray) & " "
lngSpalte = lngSpalte - 1
End If
Case 4
' Datum und Uhrzeit
ActiveSheet.Cells(lngI, lngSpalte) = arrDaten(lngArray) & " " & arrDaten( _
lngArray + 1)
Case 6
' Nachname und Vorname
ActiveSheet.Cells(lngI, lngSpalte - 1) = arrDaten(lngArray) & " " & arrDaten( _
lngArray + 1)
Case 8 To 100
' Rest
strhelp = strhelp & arrDaten(lngArray) & " "
End Select
lngSpalte = lngSpalte + 1
Next lngArray
' Rest eintragen
ActiveSheet.Cells(lngI, 6) = strhelp
Next lngI
End Sub