Přidat otázku mezi oblíbenéZasílat nové odpovědi e-mailem Formát buňky v Excelu

Nnnno,
nechce ma to poslúchať (potrebujem prevody medzi formátmi a nejak mi to nejde), tak som to vyriešil okľukou amatérsky, ale funkčne.
Potrebujeme dve bunky ako pomocné (v danom prípadne sú to E1 a E2, ak to nebude vyhovovať, vzhľadom na hlavičku, prehoď si to inde), kde sa vyhodnotí korektnosť dátumu, takže nie je potrebné žiadne ošetrovanie desatinných čiarok, rozsahov dátumov alebo iných habaďúr, či ide naozaj o dátum.
Do kódu som vložil aj naplnenie bunky E2 vzorcom, zneviditeľnenie obsahu pomocných buniek a farebné zvýraznenie bunky s chybou v dátume, aby si ani s tým nemal starosť (stačilo by ich tam raz dať manuálne ale aj o to som Ťa odľahčil. Takto sa to síce každým dátumom napĺňa opakovane, ale to nevadí).
A formát stĺpcov, do ktorých sa budú tieto dátumy zadávať musíš nastaviť na "text", inak za určitých okolností môže dôjsť k chybe (inak aj to by sa dalo dať do kódu)

Skús

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Chyba
Application.EnableEvents = False
    If (Target.Column <> 1 _
        And Target.Column <> 2 _
        And Target.Column <> 3 _
        And Target.Column <> 4 _
        And Target.Column <> 6) _
        Or Target.Row < 5 Or Target = "" Then
        Application.EnableEvents = True
        Exit Sub
    End If
    If Mid(Target, 5, 1) > 4 Then
        Stoleti = 19
        Else: Stoleti = 20
    End If
    Target = Left(Target, 2) & "." & Mid(Target, 3, 2) & "." & Stoleti & Right(Target, 2)
    
'pomocné bunky E1 a E2
    Range("E1:E2").NumberFormat = ";;;"
    Range("E1") = Target
    Range("E2").FormulaR1C1 = "=IF(ISERROR(DATEVALUE(R[-1]C)),""Chyba"","""")"
    If Range("E2") = "Chyba" Then
        Target.Font.Color = RGB(255, 0, 0)
        Target.Select
        MsgBox "Zadaný údaj nereprezentuje dátum!" & Chr(13) & "Oprav!", vbCritical, "Chyba"
        Else: Target.Font.Color = RGB(0, 0, 0)
    End If
  
    Application.EnableEvents = True
    Exit Sub
Chyba:
    MsgBox "Iná chyba"
    Application.EnableEvents = True
    Exit Sub
End Sub

Reakce na odpověď

1 Zadajte svou přezdívku:
2 Napište svou odpověď:
3 Pokud chcete dostat ban, zadejte libovolný text:

Zpět do poradny