verschiedenes Format für Datum

Hallo liebe Experten,
ich brauch wieder einmal eurer Hilfe.
In meiner Tabelle stehen in der Spalte I ab Zeile 2 immer ein Wert der für ein Datum und eine Uhrzeit steht.
Der Wert hat aber ein unterschiedliches Format. Einmal 07/23/2006 06:29:08 und ein anderes mal 07.23.2006 06:29
Diese Formate müssen jetzt auseinander genommen werden und in Spalte P soll das Datum stehen und in Spalte Q die Zeit.
Aus der Zeit soll die Stunde extraiert werden und in Spalte R geschrieben werden. Mit dem Format MM/TT/JJJJ hh:mm:ss habe ich mir schon etwas geschrieben - da aber nun noch das andere Format auftaucht klappt das makro nicht mehr.
Hier mein bisheriger Ansatz:
' Daten aus Spalte I kopieren
Range("I3:I" & Cells(Rows.Count, 9).End(xlUp).Row).Select
Selection.Copy
'Daten aus Spalte I in Spalte P einfuegen
Range("P3").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
'Text in Spalten - Auftrennung Datum Zeit
Selection.TextToColumns Destination:=Range("P3"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
'
Range("R3").Select
ActiveCell.FormulaR1C1 = "=HOUR(RC[-1])"
Range("S3").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-5] Range("T3").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-6]>R1C19,1,0)"
Range("U3").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-7]>R1C21,1,0)"
'autoausfüllen
Range("R3:U3").Select
Selection.AutoFill Destination:=Range("R3:U" & Cells(Rows.Count, 1).End(xlUp).Row), Type:=xlFillDefault
'nach Datum + Zeit sortieren
'
Range("A2:U" & Cells(Rows.Count, 1).End(xlUp).Row).Select
Selection.Sort Key1:=Range("P3"), Order1:=xlAscending, Key2:=Range("Q3") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
Bin für jeden Hinweis dankbar.
Gábor

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Gábor,
ausgehnd davon, dass das Datum in Spalte I als Text vorliegt, wobei die Punktschreibweise Deutsches Datum mit TT.MM.JJJJ ist und die Schrägstrichchreibweise Amerikanisches Datum mit MM/TT/JJJJ ist, kann man Datum, Uhrzeit und Stunde wie folgt in die spalten P bis R per Makro eintragen. Das 1. Makro trägt nur Werte ein, das 2. Makro gibt Formeln in die zellen ein. Die Formel zur Datumsberechnung entscheidet am "/" ob Deutsch oder Amerikanisch und baut dann den Datums-Text für die Funktion DATWERT entsprechend zusammen.


Sub DatumZeitKonverterWerte()
Dim wks As Worksheet, Zelle As Range
Set wks = ActiveSheet
For Each Zelle In wks.Range(wks.Cells(3, "I"), wks.Cells(wks.Rows.Count, "I").End(xlUp))
'Datum extrahieren und in Spalte P eintragen
If InStr(1, Zelle.Text, "/") = 0 Then
'Datumsschreibweise ist mit Punkt (TT.MM.JJJJ, Deutsch)
wks.Cells(Zelle.Row, "P") = CDate(Mid(Zelle.Text, 1, 2) & "." & Mid(Zelle.Text, 4, 2) & "." & Mid(Zelle.Text, 7, 4))
Else
'Datumsschreibweise ist mit Schrägstrich (MM/TT/JJJJ, Amerikanisch)
wks.Cells(Zelle.Row, "P") = CDate(Mid(Zelle.Text, 4, 2) & "." & Mid(Zelle.Text, 1, 2) & "." & Mid(Zelle.Text, 7, 4))
End If
wks.Cells(Zelle.Row, "P").NumberFormat = "DD.MM.YYYY"
'Zeit extrahieren und in Spalte Q eintragen
wks.Cells(Zelle.Row, "Q") = CDate(Mid(Zelle.Text, 12, 10))
wks.Cells(Zelle.Row, "Q").NumberFormat = "hh:mm:ss"
wks.Cells(Zelle.Row, "R") = Hour(wks.Cells(Zelle.Row, "Q"))
Next Zelle
End Sub
Sub DatumZeitKonverterFormeln()
Dim wks As Worksheet, Zelle As Range
Set wks = ActiveSheet
With wks
'Formel für Datum in Spalte P eintragen
.Cells(3, "P").NumberFormat = "DD.MM.YYYY"
.Cells(3, "P").FormulaR1C1 = _
"=IF(ISERROR(SEARCH(""/"",RC[-7],1)),DATEVALUE(MID(RC[-7], 1,2) & ""."" & MID(RC[-7], 4, 2) & ""."" & MID(RC[-7], 7,4)),DATEVALUE(MID(RC[-7], 4,2) & ""."" & MID(RC[-7], 1, 2) & ""."" & MID(RC[-7], 7,4)))"
'Formel für Zeit  in Spalte Q eintragen
.Cells(3, "Q").NumberFormat = "hh:mm:ss"
.Cells(3, "Q").FormulaR1C1 = "=TIMEVALUE(MID(RC[-8],12,10))"
'Formel für Stunde in Spalte R eintragen
.Cells(3, "R").FormulaR1C1 = "=HOUR(RC[-1])"
'Formeln nach unten auffüllen
.Range("P3:R" & .Cells(.Rows.Count, "I").End(xlUp).Row).FillDown
End With
End Sub

gruss
Franz

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread