Clever-Excel-Forum

Clever-Excel-Forum > Office-Anwendungen > Excel > Excel vba Datum formatieren
Normale Version: Excel vba Datum formatieren
Du siehst gerade eine vereinfachte Darstellung unserer Inhalte. Normale Ansicht mit richtiger Formatierung.
Seiten: 1 2

sharky51

10.12.2018, 22:52
Guten Abend Cadmus,
ja es gibt wohl einige Datumselemente wo man nicht weiß was sie bedeuten sollen - so wie Du es beschrieben hast.
Vielleicht gibt es noch eine Idee?

Ich habe trotzdem mal versucht was zu basteln. Kuckst Du:

Tabelle2
ABC
1StellenOriginalFormatiert
271112019'11.1.2019
371122019'11.2.2019
472632018'26.3.2018
572252018'22.5.2018
672672018'26.7.2018
76112018'1.1.2018
873102018'3.10.2018
981811201818.11.2018
1082511201825.11.2018
1172122018'21.2.2018
1279122018'9.12.2018
1381612201816.12.2018

Zahlenformate
Zelle Format Inhalt
C9 'TT.MM.JJJJ 43422
C10 'TT.MM.JJJJ 43429
C13 'TT.MM.JJJJ 43450
Zellen mit Format Standard werden nicht dargestellt
http://excel-inn.de/dateien/vba_beispiel..._addin.zip
http://Hajo-Excel.de/tools.htm
XHTML-Tabelle zur Darstellung in Foren, einschl. der neuen Funktionen ab Version 2007
Add-In-Version 25.15 einschl. 64 Bit



Hier der Code:
Code:
Sub Datum_Umwandeln()
   For lngRow = 2 To Cells(Rows.Count, 3).End(xlUp).Row
       If (Len(Cells(lngRow, 3)) = 8 Or Len(Cells(lngRow, 3)) = 7 Or Len(Cells(lngRow, 3)) = 6) And IsNumeric(Cells(lngRow, 3)) Then
           If Len(Cells(lngRow, 3)) = 8 Then
               Cells(lngRow, 3).Value = CDate(Mid(Cells(lngRow, 3), 1, 2) & "." & Mid(Cells(lngRow, 3), 3, 2) & "." & Mid(Cells(lngRow, 3), 5, 4))
           ElseIf Len(Cells(lngRow, 3)) = 7 And IsNumeric(Cells(lngRow, 3)) Then
               strFull = Cells(lngRow, 3)
               strZahl = Left(strFull, 2)
               If strZahl >= 31 And Mid(Cells(lngRow, 3), 2, 2) <= 12 Then  '0 Or Mid(Z, 3, 2) > 12 Then
               Cells(lngRow, 3).Value = CSting2date(Cells(lngRow, 3))
               Cells(lngRow, 1).Interior.ColorIndex = 35 ' lindgrün
               Cells(lngRow, 3).Interior.ColorIndex = 35 ' lindgrün
               ElseIf Mid(Cells(lngRow, 3), 3, 1) = 0 And Left(Cells(lngRow, 3), 1) <= 9 Then
                   Cells(lngRow, 3).Interior.ColorIndex = 3 ' rot
                   Cells(lngRow, 3).Value = CSting2date(Cells(lngRow, 3))
           Else
               Cells(lngRow, 3).Value = CSting1date(Cells(lngRow, 3))
               Cells(lngRow, 1).Interior.ColorIndex = 44 ' orange
               Cells(lngRow, 3).Interior.ColorIndex = 44 ' orange
           End If
       Else
           Cells(lngRow, 3).Value = CSting1date(Cells(lngRow, 3))
       End If
   Else
       Cells(lngRow, 3).Value = CDate(Mid(Cells(lngRow, 3), 1, 1) & "." & Mid(Cells(lngRow, 3), 2, 1) & "." & Mid(Cells(lngRow, 3), 3, 4))
   End If
Next lngRow
End Sub

'Wenn Datum 7-stellig, links <= 31, Mid <=12
Function CSting1date(s As String) As String
   Dim t As String
   t = "." & Right(s, 4)
   s = Left(s, Len(s) - 4)
   t = "." & Right(s, 1) & t
   s = Left(s, Len(s) - 1)
   CSting1date = s & t
   'Z = CSting1date
End Function

'Wenn Datum 7-stellig, links >= 31, Mid <=12
Function CSting2date(s As String) As String
   Dim t As String
   t = "." & Right(s, 4)
   s = Left(s, Len(s) - 4)
   t = "." & Right(s, 2) & t
   s = Left(s, Len(s) - 2)
   CSting2date = s & t
   'Z = CSting2date
End Function

sharky51

10.12.2018, 22:55
Hallo Michael,

vielen Dank, werde Deinen Lösungsvorschlag morgen mal testen.

snb

11.12.2018, 00:11
Ein UDF:


Code:
Function F_snb(c00)
    F_snb = Format(c00, "00.00.0000")
    If Not IsDate(F_snb) Then F_snb = Format(c00, "0.0.0000")
    If Not IsDate(F_snb) Or Mid(F_snb, 4, 2) > 12 Then F_snb = Format(c00, "00.0.0000")
    F_snb = CDate(F_snb)
End Function

sharky51

11.12.2018, 09:33
Guten Morgen,

danke für den Vorschlag, aber wie binde ich die Funktion denn richtigerweise ein?

Wenn ich es so mache dann kommt eine Fehlermeldung in der Funktion: "Typen unverträglich" bei der Codezeile "F_snb = CDate(F_snb)"
Code:
Sub FormatTest()
   For lngRow = 2 To Cells(Rows.Count, 12).End(xlUp).Row
   Cells(lngRow, 12).NumberFormat = F_snb("L" & lngRow)
   Next lngRow
End Sub

sharky51

11.12.2018, 12:20
Hallo Michael,

habe Deine Routine mal getestet - funktioniert im Prinzip gut - nur mit den beschriebenen neuralgischen Werten klapp es leider nicht.
Siehe z.B. diese Werte hier:

HTML_AddIn11_12_2018_12_12_39
LM
1OriginalAusgabe
21112019N/A
31122019N/A
112122018N/A
603112018N/A
2921122018N/A
3913122018N/A

Zahlenformate
Zelle Format Inhalt
M4 'TT.MM.JJJJ 43185
M364 'TT.MM.JJJJ 43739
Zellen mit Format Standard werden nicht dargestellt
http://excel-inn.de/dateien/vba_beispiel..._addin.zip
http://Hajo-Excel.de/tools.htm
XHTML-Tabelle zur Darstellung in Foren, einschl. der neuen Funktionen ab Version 2007
Add-In-Version 25.15 einschl. 64 Bit



Dazu gibt es anscheinend keine praktikable Lösung. Du hast das ja bereits angemerkt.

Kuwer

11.12.2018, 12:23
Hallo Erich,

(11.12.2018, 12:20)sharky51 schrieb: [ -> ]Dazu gibt es anscheinend keine praktikable Lösung. Du hast das ja bereits angemerkt.

das hattest Du doch hier schon eingesehen: #4 Wink

Gruß Uwe

Der Steuerfuzzi

11.12.2018, 12:33
Du kannst die Werte natürlich in ein Datum umwandeln, dumusst dich nur für einen Modus entscheiden (Tag zweistellig/Monat einstellig oder Tag einstellig/Monat zweistellig).
Oder gibt es sontige Anhaltspunkte, wie das Datum zu behandeln wäre (z. B. das Datum ist in einer Reihe von Werten im gleichen Monat o.Ä.)?

sharky51

11.12.2018, 13:24
Na ja, die Hoffnung stirbt ja angeblich zuletzt.
Aber ich lasse es jetzt mal gut sein!

Trotzdem vielen Dank an dieses tolle Forum!!!

sharky51

11.12.2018, 13:33
Der einzige Anhaltspunkt ist dass ich "weiß" welches Datum richtig ist - aber Excel spricht halt nicht mit mir Angry
Werde die anfallenden Daten, in der Hoffnung dass es nicht zu viele sind, jetzt manuell formatieren.
Seiten: 1 2
Clever-Excel-Forum > Office-Anwendungen > Excel > Excel vba Datum formatieren