Daten aus einer Zelle splitten

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub splitdatum() Dim x As Range Dim artmp Dim i As Long, y As Long Dim pos As Long, cnt As Long Dim sRange As String cnt = 2 Do While Range("A" & cnt) "" y = 0 Set x = Range("A" & cnt) If Right(x.Value, 1) = ")" Then x.Offset(, 1 + y) = CDate(Left(x.Value, 10)) y = y + 1 Else If Len(x) > 12 Then sRange = Replace(x, "+", "") sRange = Replace(sRange, "/", "") artmp = Split(sRange, " ") For pos = LBound(artmp) To UBound(artmp) If artmp(pos) "" Then x.Offset(, 1 + y) = CDate(artmp(pos)) y = y + 1 End If Next Else x.Offset(, 1 + y) = CDate(x.Value) y = y + 1 End If End If cnt = cnt + 1 Loop End Sub

Sub splitdatum() Dim x As Range Dim artmp Dim i As Long, y As Long Dim pos As Long, cnt As Long Dim sRange As String cnt = 2 Do While Range("BC" & cnt) "" y = 55 Set x = Range("BC" & cnt) If Right(x.Value, 1) = ")" Then x.Offset(, 1 + y) = CDate(Left(x.Value, 10)) y = y + 1 Else If Len(x) > 12 Then sRange = Replace(x, "+", "") sRange = Replace(sRange, "/", "") artmp = Split(sRange, " ") For pos = LBound(artmp) To UBound(artmp) If artmp(pos) "" Then x.Offset(, 1 + y) = CDate(artmp(pos)) y = y + 1 End If Next Else x.Offset(, 1 + y) = CDate(x.Value) y = y + 1 End If End If cnt = cnt + 1 Loop End Sub

das Problem hättest du nicht, wenn du gleich die Beispieldatei korrekt gebaut hättest.
Sind die Beispieldaten denn wenigstens repräsentativ und vollständig was die Datenstruktur angeht?
y +1 muß die Startspalte für das Einfügen ergeben.
hier mal mit Erklärungen. Hoffentlich hilfts.


If Right(x.Value, 1) = ")" Then  'Prüfung ob eine Uhrzeit in Zelle steht, erkennbar an der letzten  Klammer
x.Offset(, 1 + y) = CDate(Left(x.Value, 10))
'  y = y + 1  'das kann hier evtl raus
Else
If Len(x) > 12 Then 'nochmals Prüfung ob in der Zelle mehr Zeichen als  datum + Zeit drin steht
sRange = Replace(x, "+", "")              'Trennzeichen raus, Ergebnis nach Variable sRange
sRange = Replace(sRange, "/", "")     'Trennzeichen raus, Ergebnis überschreibt Variable sRange
artmp = Split(sRange, " ")                                 'sRange in array aufteilen
For pos = LBound(artmp) To UBound(artmp)   'schleife über die Werte des Array
If artmp(pos)  "" Then                              'leere Werte vermeiden
x.Offset(, 1 + y) = CDate(artmp(pos))       'Datum eintragen
y = y + 1                                                   'Einfügespalte nach rechts rücken
End If
Next
Else
falls doch weniger als 13 Zeichen  in der Zelle stehen , dann wert direkt eintragen
x.Offset(, 1 + y) = CDate(x.Value)
' y = y + 1   'das kann evtl auch raus
End If
End If
cnt = cnt + 1  'Zeilenzähler in Spalte A nach unten
Loop
End Sub

Sub splitdatum() Dim x As Range Dim artmp Dim pos As Long, cnt As Long, y As Long Dim sRange As String cnt = 2 'startZeile der Daten Do While Range("BC" & cnt) "" y = 0 Set x = Range("BC" & cnt) sRange = Replace(x, "+", "") sRange = Replace(sRange, "/", "") artmp = Split(sRange, " ") For pos = LBound(artmp) To UBound(artmp) If artmp(pos) "" Then If IsDate(artmp(pos)) And Len(artmp(pos)) > 9 Then x.Offset(, 1 + y).Value = CDate(artmp(pos)) y = y + 1 End If End If Next cnt = cnt + 1 Loop End Sub

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Daten aus einer Zelle splitten

16 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread