Excel a krátký formát datumu ve Windows 8

“Kdyby peklo nebylo, tak by si ho musel Microsoft vymyslet.” Roky říkám uživatelům, že mezery v datumu jsou sice správně typograficky, nicméně Excel je nesnáší a varoval jsem před změnami v nastavení systému Windows. No a nenašel se v Redmondu nějaký dobrodruh, který ve Windows 8/8.1 mezery narval do krátkého formátu datumu jako výchozí? A tak se ozval třeba včera uživatel, že mu nefunguje konverze datumu ve formátu řetězce na skutečné datum typu Date.

Windows 8 - krátký formát datumu

Windows 8 – krátký formát datumu

Pokud Windows 8 nemáte, můžete si situaci nasimulovat i ve Windows 7 a starších.

Excel - krátký formát datumu s mezerami

Excel – krátký formát datumu s mezerami

Nejjednodušší je samozřejmě v nastavení systému mezery odmazat. Co když si to ale nemůžete dovolit a potřebujete univerzální makro? Po několika hodinách se mi podařilo sepsat vlastní funkci, která – jak doufám – pokrývá alespoň běžné stavy. Vůbec si ale nedělám iluze o její rychlosti na tisících datumech. Pracuje zkrátka s textovými řetězci a to chvíli trvá. Třeba se vám podaří najít elegantnější řešení.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
Sub DatumPrevod()

    Dim strDatum As String

    Dim dtDatum As Date

    strDatum = "19.3.2014"

    'když selhává
    'dtDatum = CDate(strDatum)
    'a podobně končí chybou i další
    'dtDatum = Format(strDatum, "Short Date")
    'dtDatum = DateValue(strDatum)
    'dtDatum = Evaluate("=DATEVALUE(""" & strDatum & """)")

    'pak je potřeba postupovat jinak...
 
    dtDatum = CDate(epfDATUMTEXT(strDatum, "d.m.yyyy"))

End Sub

Function epfDATUMTEXT(strDatumZdroj As String, strDatumZdrojMaska As String, _
    Optional strDatumCilMaska As String) As String

    Dim lngLCID As Long
    Dim lngRet As Long
    Dim intDen As Integer, intMesic As Integer, intRok As Integer
    Dim intPocetD As Integer, intPocetM As Integer, intPocetY As Integer

    Dim strD As String, strM As String, strY As String, strZnak As String, _
        strTemp As String
    Dim strDatumCil As String, strDatumFormatKratky As String

    'jaký je formát pro datum?
    'nedostačující informace
    'Application.International(...)

    'oddělovače ze systému, tj.
    'Application.UseSystemSeparators = True
    If Len(strDatumCilMaska) = 0 Then
        'krátký formát datumu ze systému
        'LCID ... identifikátor oblasti/jazyka
        'čeština ... 1029
        lngLCID = GetUserDefaultLCID()
        strDatumFormatKratky = Space$(16)
        lngRet = GetLocaleInfo(lngLCID, LOCALE_SSHORTDATE, _
            strDatumFormatKratky, 16)
        strDatumCilMaska = Left$(strDatumFormatKratky, lngRet - 1)
    End If

    'pro každý znak původní masky
    For i = 1 To Len(strDatumZdrojMaska)
        'znak masky
        strZnak = UCase(Mid$(strDatumZdrojMaska, i, 1))
        'odpovídající znak ve zdrojovém datumu
        strTemp = Mid$(strDatumZdroj, i + j, 1)

        If (InStr(1, "DMY", strZnak) = 0) And (IsNumeric(strTemp)) Then
            strZnak = strX
            j = j + 1
        End If

        'nabalování číslic do řetězce patřičné skupiny
        Select Case strZnak
            Case "D"
                strD = strD & strTemp
                strX = "D"
            Case "M"
                strM = strM & strTemp
                strX = "M"
            Case "Y"
                strY = strY & strTemp
                strX = "Y"
        End Select
    Next i

    'převod na číselné hodnoty
    intDen = Val(strD)
    intMesic = Val(strM)
    intRok = Val(strY)

    strDatumCilMaskaTemp = UCase(strDatumCilMaska)

    'počty zástupných znaků v cílové masce
    intPocetD = Len(strDatumCilMaskaTemp) - Len(Replace(strDatumCilMaskaTemp, _
        "D", ""))
    intPocetM = Len(strDatumCilMaskaTemp) - Len(Replace(strDatumCilMaskaTemp, _
        "M", ""))
    intPocetY = Len(strDatumCilMaskaTemp) - Len(Replace(strDatumCilMaskaTemp, _
        "Y", ""))

    'záměna zástupných znaků v cílové masce za skutečné hodnoty
    strDatumCil = Replace(strDatumCilMaskaTemp, String(intPocetD, "D"), _
        Format(intDen, String(intPocetD, "0")))
    strDatumCil = Replace(strDatumCil, String(intPocetM, "M"), Format(intMesic, _
        String(intPocetM, "0")))
    strDatumCil = Replace(strDatumCil, String(intPocetY, "Y"), Right(intRok, _
        intPocetY))

    epfDATUMTEXT = strDatumCil

End Function

Alespoň několik poznámek:

  • Funkce s pomocí API zjišťuje formát krátkého datumu v systému (API funkce jsou uvedeny pouze v sešitu, zde nejsou vypsány).
  • Funkce nezvládá rozdělené sekvence stejného typu (například yy-yy jako rok 20-14).
  • Funkce jakžtakž zvládá fakticky nesourodé datumy a jejich masky (běžné “d.m.yyyy” pro 19.3.2014 jistě chápete vy i Excel, ale naučte to vlastní program, kde jednomu “d” odpovídá jedna nebo dvě číslice…).
  • Je zvláštní, že funkce listu DATUMHODN (stejně jako rozpoznávací funkce při ručnímu vstupu do buňky) zblajzne kde co a vrátí datum, zatímco její užití v rámci VBA a Evaluate neprojde (pod WorksheetFunction není dostupná, protože VBA obsahuje vlastní funkci DateVaue).
  • Formát buňky pro datum obsahuje systémové formáty a značí je hvězdičkou. A i když popisek v okně tvrdí, jak jsou provázané se systémem, já tvrdím, že si “melou svou” bez ohledu na nastavení ve Windows.
  • Funkci je možné zkrátit. V momentě, kdy naplníte proměnné intDen, intMesic a intRok, aplikujte VBA funkci DateSerial a obdržíte datum typu Date. Já to dotáhnul až do řetězcové podoby odpovídající krátkému formátu datumu.
Excel - formát buňky pro datum

Excel – formát buňky pro datum

Další ukázky užití výše uvedené funkce:

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Test_epfDATUMTEXT()
   
    Dim strDatum1 As String
    Dim strDatum2 As String
   
    'zdrojové datum, zdrojová maska datumu, cílová maska datumu
    strDatum1 = epfDATUMTEXT("19-03|2014", "dd-MM/yyyy", "yy/mm/dd")
   
    'zdrojové datum, zdrojová maska datumu, cílová maska datumu
    'dle krátkého formátu datum v systému Windows
    strDatum2 = epfDATUMTEXT("19-03|2014", "dd-MM/yyyy")

End Sub
Excel - vlastní funkce pro datum zadané textem

Excel – vlastní funkce pro datum zadané textem

Sešit ke stažení:
[download id=”500″]

Klikni a stahuj!