Hromadná změna datumu a času v buňkách

Úvodní stránka | Blog | Excel VBA | Hromadná změna datumu a času v buňkách

    • Hromadná změna datumu a času v buňkách je realizovatelná ručním přepisem, funkcemi DATUM a ČAS (ve VBA funkce DateSerial a TimeSerial), případně funkcí EDATE a poslepováním dalších funkcí. Připomínám, že pro aktuální datum slouží klávesová zkratka Ctrl + ; (středník), a pro čas Ctrl + Shift + : (dvojtečka). Na listu daný úkol zvládají i funkce DNES a NYNÍ (čas je rozdíl NYNÍ-DNES), ve VBA pak máme funkce Date a Now, resp. Time.

    Hromadná změna datumu a času v buňkách
    Hromadná změna datumu a času v buňkách

    Ruční úpravy datumu a času ve více buňkách jsou asi nejotravnější možností. Na numerickém bloku klávesnice nemáme k dispozici ani tečku pro datum, ani dvojtečku pro čas (u ní navíc potřebujeme Shift). U datumu si můžeme pomoci tak, že kupříkladu vstup 9/1 do (předem naformátované) buňky Excel zamění za 9.1. aktuálního roku (9.1.2019). Pro čas se hodí přidat nahrazení dvou čárek za dvojtečku do Automatických oprav (viz Soubor / Možnosti / Kontrola pravopisu a mluvnice / tlačítko Možnosti automatických oprav). Zápis 9,,26 bude tedy nahrazen za 9:26.

    Automatické nahrazování dvou čárek za dvojtečku
    Automatické nahrazování dvou čárek za dvojtečku

    Celé je to ale kostrbaté a pomalé. My se proto dnes naučíme, jak posouvat datum a čas oběma směry s využitím maker a vestavěné funkce DateAdd, jež nabízí ve svém prvním parametru řadu možností pro posun jak v kalendáři, tak v čase obecně. Lehce jsem se přitom inspiroval článkem Entering Times Into Cells.

    V případě datumu nebudeme ošetřovat případ, kdy by překročilo hranici 1.1.1900, což je na listu nejzazší datum (zatímco ve VBA je jím 1.1.100). U času už si ovšem musíme pohlídat překlápění přes půlnoc. A problémů je u něj daleko více. Ve VBA existuje jen jeden datový typ společný datumu a času – Date. Při vracení hodnot typu Date zpět do listu můžeme narazit na problémy s formátem buňky. Proto je jistější vracet interní hodnotu – pro datum je jím velké celé číslo a pro čas desetinné číslo. Pro algoritmus se tedy hodí matematické a konverzní funkce. Musíme si přitom uvědomit rozdíly mezi funkcemi Int a CInt, a stejně tak přibrzdit při myšlence použít operátor Mod (který se chová jinak, než funkce MOD na listu).

    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
    Sub DatumPosun(Jednotka As String, Posun As Integer)

        Dim varPole() As Variant
        Dim varPolozka As Variant
        Dim lngHodnota As Long

        'prvni parametr pro DateAdd
        'yyyy ... Year
        'q ... Quarter
        'm ... Month
        'y ... Day of year
        'd ... Day
        'w ... Weekday
        'ww ... Week

        'pokud neni vybrana oblast bunek...
        If TypeName(Selection) <> "Range" Then
            'opusteni procedury
            Exit Sub
        End If

        'vypnuti prepoctu listu
        Application.Calculation = xlCalculationManual
       
        's vyberem...
        With Selection
       
            'redimenzovani pole
            ReDim varPole(1 To .Rows.Count, 1 To .Columns.Count)

            'pro kazdou bunku vyberu
            For i = 1 To UBound(varPole, 1)
                For j = 1 To UBound(varPole, 2)
                    'test na datum
                    If IsDate(.Cells(i, j)) Then
                        'prepocet datumu
                        lngHodnota = CLng(DateAdd(Jednotka, Posun, _
                            .Cells(i, j)))
                        varPole(i, j) = lngHodnota
                    'pokud v bunce neni datum
                    Else
                        'pouze prevzeti obsahu bunky
                        varPole(i, j) = .Cells(i, j)
                    End If
                Next j
            Next i

        End With

        'preklopeni pole zpet do listu
        Selection = varPole

        'zapnuti prepoctu listu
        Application.Calculation = xlCalculationAutomatic

    End Sub
    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
    Sub CasPosun(Jednotka As String, Posun As Integer)

        Dim varPole() As Variant
        Dim varPolozka As Variant
        Dim dblHodnota As Double
       
        'prvni parametr pro DateAdd
        'h ... Hour
        'n ... Minute
        's ... Second

        'pokud neni vybrana oblast bunek...
        If TypeName(Selection) <> "Range" Then
            'opusteni procedury
            Exit Sub
        End If

        'vypnuti prepoctu listu
        Application.Calculation = xlCalculationManual

        's vyberem...
        With Selection
       
            'redimenzovani pole
            ReDim varPole(1 To .Rows.Count, 1 To .Columns.Count)

            'pro kazdou bunku vyberu
            For i = 1 To UBound(varPole, 1)
                For j = 1 To UBound(varPole, 2)
                    'test na cas ... Dick Kusleika
                    If IsDate(.Cells(i, j).Text) And Not IsDate(.Cells(i, _
                        j).Value) Then
                        'prepocet casu
                        dblHodnota = Abs(CDbl(DateAdd(Jednotka, Posun, _
                            .Cells(i, j))))
                        varPole(i, j) = dblHodnota - Int(dblHodnota)
                    Else
                        'pouze prevzeti obsahu bunky
                        varPole(i, j) = .Cells(i, j)
                    End If
                Next j
            Next i

        End With

        'preklopeni pole zpet do listu
        Selection = varPole

        'zapnuti prepoctu listu
        Application.Calculation = xlCalculationAutomatic

    End Sub

    Pozn. Jestliže na listu chybí ekvivalent VBA funkce DateAdd, pak list vrací úder v podobě funkce WORKDAY, která pro změnu nemá sestřičku pod VBA. Musíme si ji tedy buď doprogramovat, nebo si ji vypůjčit přes WorksheetFunction.WorkDay (což je lepší varianta, protože případné svátky je také výhodnější generovat na listu, v reálu řekněme plus minus jeden rok vůči aktuálnímu roku). Níže uvedený kód čerpá svátky z pojmenované oblasti buněk – definovaný název Svatky (list Výpis svátků z přílohy).

    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
    Sub PracovniDenPosun(Posun As Integer)

        Dim varPole() As Variant
        Dim varPolozka As Variant
        Dim lngHodnota As Long

        'pokud neni vybrana oblast bunek...
        If TypeName(Selection) <> "Range" Then
            'opusteni procedury
            Exit Sub
        End If

        'vypnuti prepoctu listu
        Application.Calculation = xlCalculationManual
       
        's vyberem...
        With Selection
       
            'redimenzovani pole
            ReDim varPole(1 To .Rows.Count, 1 To .Columns.Count)

            'pro kazdou bunku vyberu
            For i = 1 To UBound(varPole, 1)
                For j = 1 To UBound(varPole, 2)
                    'test na datum
                    If IsDate(.Cells(i, j)) Then
                        'prepocet datumu
                        lngHodnota = _
                            CLng(WorksheetFunction.WorkDay(.Cells(i, j), _
                            Posun, Range("Svatky")))
                        varPole(i, j) = lngHodnota
                    'pokud v bunce neni datum
                    Else
                        'pouze prevzeti obsahu bunky
                        varPole(i, j) = .Cells(i, j)
                    End If
                Next j
            Next i

        End With

        'preklopeni pole zpet do listu
        Selection = varPole

        'zapnuti prepoctu listu
        Application.Calculation = xlCalculationAutomatic

    End Sub

    Nyní již vám nic nebrání zpracovat vlastní varianty procedur a řídit tak posuny pro datum a čas programově.

    1
    2
    3
    4
    5
    6
    7
    Sub TestDatumCasPosun()

        Call DatumPosun("ww", 1)
        'Call CasPosun("h", -1)
        'Call PracovniDenPosun(-3)

    End Sub

    Ke stažení
    datum_cas_posun.zip

    Uložit článek jako PDF