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í:
excel-datum-kratky-format.zip

Uložit článek jako PDF