Sloučená buňka

Úvodní stránka | Blog | Excel VBA | Sloučená buňka

    • Hned zkraje se nabízí otázka, zda-li používat termín „sloučená buňka“ nebo „sloučené buňky“. Obojí je správně. Fyzicky se jedná o sloučené buňky, nicméně – jak uvidíte později – navenek se oblast chová jako jednobuňková (dovolím si i výraz „prvobuňková“).

    Sloučená buňka - kolik vidíte v ohraničené oblasti celkem čtverců?
    Sloučená buňka – kolik vidíte v ohraničené oblasti celkem čtverců?

    Pro potřeby optického překrývání oblasti hodnotou je sloučená buňka fajn, nicméně po stránce technické (datové) je to bez pardonů svinstvo. Předesílám, že vizuálně ji dokáže zastoupit volba Vodorovně: Na střed výběru (viz dialog Formát buňky a záložka Zarovnání, použití ukázáno na hlavičce s filtrem dále v článku).

    Úvodní kód VBA berte na tomto místě spíš jako informativní, i když je okomentovaný, smysl má odkrokovaný a to za současného sledování dění na listu.

    Tip: Ve Windows 7 můžete aktivní okno zarovnat do levé (pravé) části obrazovky s pomocí klávesové zkratky WIN+šipka v daném směru.

    Pokud bych měl popsat programový způsob práce se sloučenou oblastí jen jednou větou, pak vězte, že v nabídce jsou metody Merge (sloučit) a UnMerge (rozdělit) nebo vlastnost MergeCells s hodnotou True (sloučeno) a False (rozděleno).

    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
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    Sub SloucenaBunka()

        'kód si krokujte a sledujte zpracovávanou oblast

        Dim rngSlouceneBunky As Range
        Dim rngSloupec As Range

        Dim dblHodnotaB3 As Double
        Dim dblHodnotaB4 As Double
        Dim dblSirkaSloupceB3 As Double
        Dim dblSirkaSloupceB3D5 As Double
        Dim dblSirkaTemp As Double

        Dim intPocetBunek As Integer

        Dim boolSoucastSlouceneOblasti As Boolean

        Dim strAdresa As String

        'aktivace listu pro účely testování
        wshTesty.Activate

        '****************************
        '1. Metoda Merge poprvé
        '****************************

        'výběr buňky B3
        Range("B3").Select

        'sloučení všech buněk oblasti
        'metoda Merge
        'výběr B3 se nezmění
        'formát z B3
        Range("B3:D5").Merge

        'B3
        strAdresa = Selection.Address(0, 0)

        'výběr B3 se nezmění
        Range("B3").Activate
        'výběr B3 se změní na B3:D5
        'Range("B3").Select

        'výběr C3 se změní na B3:D5
        'Activate stejně jako Select
        Range("C3").Activate

        'zápis do buňky B3
        Range("B3") = 100
        '100
        dblHodnotaB3 = Range("B3")

        'zápis do buňky B4 neproběhne!
        'žádné chybové hlášení
        Range("B4") = 1000
        '0
        dblHodnotaB4 = Range("B4")

        'rozdělení sloučených buněk
        'metoda UnMerge
        'B3 přebírá po rozdělení obsah (vzorec),
        'formát hodnoty, pozadí i písma ze sloučení
        'resetuje se ohraničení a zarovnání buňky
        Range("B3:D5").UnMerge

        '****************************
        'Metoda Merge podruhé
        '****************************

        'výběr buňky B3
        Range("B3").Select

        'znovusloučení všech buněk oblasti
        Range("B3:D5").Merge

        'šířka buňky B3 (units)
        '20
        dblSirkaSloupceB3 = Range("B3").ColumnWidth
        'šířka oblasti B3:D5
        'lze použít jen pro stejně široké sloupce oblasti!
        'Null
        'dblSirkaSloupceB3D5 = Range("B3:D5").ColumnWidth
        'Null
        'dblSirkaSloupceB3D5 = Range("B3").MergeArea.ColumnWidth

        'korektně
        For Each rngSloupec In Range("B3").MergeArea.Columns
            dblSirkaTemp = dblSirkaTemp + rngSloupec.ColumnWidth
        Next rngSloupec
        '30
        dblSirkaSloupceB3D5 = dblSirkaTemp

        'šířka buňky B3 (points)
        '108,75
        dblSirkaSloupceB3 = Range("B3").Width
        'šířka oblasti B3:D5
        '168,75 (points)
        dblSirkaSloupceB3D5 = Range("B3:D5").Width
        'totéž
        '168,75
        dblSirkaSloupceB3D5 = Range("B3").MergeArea.Width

        'rozdělení sloučených buněk
        Range("B3:D5").UnMerge

        '****************************
        'Vlastnost MergeCells poprvé
        '****************************

        'sloučení všech buněk oblasti
        'vlastnost MergeCells
        'výběr se automaticky změní na B3:D5
        Range("B3:D5").MergeCells = True

        'sloučená oblast, do níž buňka náleží
        'B3:D5
        strAdresa = Range("C5").MergeArea.Address(0, 0)

        'F3, nikoliv D3!
        'totéž pro C3, D3
        'tj. posun od pravého okraje průniku (3.) řádku
        'se sloučenými buňkami
        Range("B3").Offset(0, 2).Select

        'spadá-li cílová buňka do jiné sloučené oblasti
        'vybírá ji celou
        'E4:F4
        'totéž pro C4, D4
        Range("B4").Offset(0, 2).Select

        'rozdělení sloučených buněk
        Range("B3:D5").MergeCells = False

        '****************************
        'Vlastnost MergeCells podruhé
        '****************************

        'nelze
        'Set rngOblast = Range("B3:D5").Merge

        'výběr buňky B3
        Range("B3").Select

        'sloučení všech buněk oblasti
        'vlastnost MergeCells
        Range("B3:D5").MergeCells = True

        'vlastnost MergeArea je aplikovatelná pouze
        'na jednu buňku (sloučené) oblasti
        'nelze
        'Range("B3:D5").MergeArea.Select

        Set rngOblast = Range("B3").MergeArea

        'počet buněk v oblasti
        '9
        intPocetBunek = rngOblast.Cells.Count

        'leží buňka ve sloučené oblasti?
        'True
        boolSoucastSlouceneOblasti = Range("C5").MergeCells = True

        'vložení vzorce (nelze aplikovat maticový)
        Range("B3").MergeArea.FormulaLocal = "=DNES()"
        'nebo
        Range("B3:D5").FormulaLocal = "=DNES()+1"

        'rozdělení sloučených buněk
        Range("B3:D5").MergeCells = False

    End Sub

    V oblasti sloučených buněk

    • nelze nastavit maticový vzorec (FormulaArray). Oblast ovšem může převzít maticový vzorec (vracející jednu hodnotu) z první buňky před sloučením
    • lze aplikovat vyhledávací funkce, můžete se ovšem dočkat nečekaných výsledků (hodnotu obsahuje pouze první buňka sloučené oblasti)
    • lze sice po technické stránce aplikovat filtr, ale rozhodně se tomuto nečistému stylu práce vyhýbejte
    • nelze jednotlivé buňky vybírat myší, klávesou TAB ani šipkami či programově (Activate, Select)
    • lze procházet rohové buňky přes CTRL+. (tečka), ovšem případný zápis hodnoty se do buňky nepromítne (neskončí ale ani chybou). Výběrem se mění objekt ActiveCell (změnu lze okem pozorovat pouze v Řádku vzorců).
    • je možné se vzorcem či programově odkazovat na jednotlivé buňky. S výjimkou první (levé horní) buňky této oblasti jsou všechny prázdné a nelze do nich zapisovat (pokus neskončí ale ani zde chybou). Změna formátu či například přidaný komentář se vizuálně projeví na celé sloučené oblasti, fakticky jsou ovšem tyto vlastnosti vázány na první buňku. Posun (Offset) respektuje rozměr sloučené oblasti v daném směru. Změna velikosti (Resize) vychází z rozměrů sloučené oblasti. Sloučená oblast se tedy navenek prezentuje jako jednobuňková (jednořádková, jednosloupcová). Pokud posun nebo změna velikosti zasahuje do jiné sloučené oblasti, pak dochází k expanzi podle této oblasti.

    Pozn. Sloučená buňka je jako švédská bedna. Ačkoliv je výška skoku různá podle jejího sestavení, vždy je ke splnění tělocvičného prvku uznatelný pouze jeden odraz a s ním spojený skok.

    Švédská bedna
    Švédská bedna

    Následuje ukázka výsledků funkcí aplikovaných na oblast se sloučenou buňkou.

    Funkci užité na oblasti se sloučenou buňkou
    Funkci užité na oblasti se sloučenou buňkou

    Snímek níže ukazuje, jak se chová sloučená buňka užitá v hlavičce s filtrem a jak se k tomu štábně postavit.

    Sloučená buňka v hlavičce s filtrem
    Sloučená buňka v hlavičce s filtrem

    A nyní se podíváme na jedno obzvláště šťavnaté téma.

    AutoFit – přizpůsobení šířky a výšky sloučené buňky

    přizpůsobení šířky sloupce podle aktuálního výběru
    ručně: karta Domů / skupina Buňky / Formát, Přizpůsobit šířku sloupců
    programově: Bunka.Columns.AutoFit

    přizpůsobení šířky sloupce podle nejdelšího obsahu ve sloupci
    ručně: dvojklik na rozhraní sloupců
    programově: Bunka.EntireColumn.AutoFit

    Pro řádky je to obdobné – Rows.AutoFit, EntireRow.AutoFit.

    Automaticky zalomený text zpravidla Excel zvládá, u ručně zalomeného textu čekejte obtíže, a u sloučených buněk už narazí kosa na kámen.

    Poradí si s tím VBA? Inu jde to, ale dře to. Doslova jsem se prošoupal do cíle s odřenými lokty i ušima.

    Obrázky dokumentují stav před a po zpracování.

    Víceřádková, jednosloupcová sloučená buňka
    Víceřádková, jednosloupcová sloučená buňka
    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
    Sub SloucenaBunka1AutoFit()

        Dim rngSloucenaBunka As Range
        Dim rngSloupec As Range
        Dim rngBunka As Range
       
        Dim astrTextMaxDelka
       
        Dim dblBunka1PrizpusobenaSirka As Double
        Dim dblBunka1PrizpusobenaVyska As Double
       
        Dim intPocetRadku As Integer
       
        Dim strObsah As String
        Dim strTemp As String

        'aktivace listu pro účely testování
        wshAutoFit.Activate
       
        '****************************
        'Příklad 1
        '****************************

        'reset výšky řádků a šířky sloupců do výchozí podoby příkladů
        With ActiveSheet.UsedRange
            .EntireRow.RowHeight = 15
            .EntireColumn.ColumnWidth = 8.43
        End With

        'víceřádková, jednosloupcová sloučená buňka se zalomením
        'Set rngSloucenaBunka = Range("B2:B3")
        Set rngSloucenaBunka = Range("B2").MergeArea

        'výběr sloučené buňky
        rngSloucenaBunka.Select
        'počet řádků sloučené buňky
        intPocetRadku = rngSloucenaBunka.Rows.Count

        With rngSloucenaBunka
            'zrušení sloučení
            .MergeCells = False
            'nekorektní pro ručně zalomený víceřádkový obsah
            '.Cells(1).EntireColumn.AutoFit
            'původní obsah první buňky
            strObsah = .Cells(1).Text
            'zrušení sloučení
            .MergeCells = False
            'a) nastavení šířky první buňky podle původní šířky sloučené buňky
            '.Cells(1).ColumnWidth = dblSloucenaBunkaPuvodniSirka
            'b) přizpůsobení šířky buňky podle její nejdelší textové položky
            'vytvoření řetězce maticové konstanty z obsahu buňky
            strTemp = "={""" & Replace(strObsah, vbLf, """;""") & """}"
            'přidání dočasného definovaného názvu
            ActiveWorkbook.Names.Add Name:="XYZnazev", RefersToR1C1:=strTemp
            'text s maximální délkou (vyhodnocen jako maticový vzorec)
            astrTextMaxDelka = _
                Evaluate("=INDEX(XYZnazev,MATCH(MAX(LEN(XYZnazev)),LEN(XYZnazev),0))")
            'odstranění dočasného názvu
            ActiveWorkbook.Names("XYZnazev").Delete
            'nejdelší textová položka (řádek) první buňky jako dočasný obsah
            .Cells(1) = astrTextMaxDelka(1)
            'zrušení zalamování
            .Cells(1).WrapText = False
            'přizpůsobení šířky první buňky nejdelší textové položce
            .Cells(1).Columns.AutoFit
            'šířka po přizpůsobení
            dblBunka1PrizpusobenaSirka = .Cells(1).ColumnWidth
            'navrácení původního obsahu
            .Cells(1) = strObsah
            'navrácení zalamování (po vložení textu k němu dojde automaticky)
            .Cells(1).WrapText = True
            'přizpůsobení výšky první buňky
            .Cells(1).Rows.AutoFit
            'výška po přizpůsobení
            dblBunka1PrizpusobenaVyska = .Cells(1).RowHeight
            'znovusloučení
            .MergeCells = True
            'nastavení přizpůsobené šířky pro první buňku
            '.Cells(1).ColumnWidth = dblBunka1PrizpusobenaSirka
            'rovnoměrné rozdělení potřebné výšky na všechny řádky
            'sloučené buňky
            .RowHeight = dblBunka1PrizpusobenaVyska / intPocetRadku
        End With

    End Sub
    Jednořádková, vícesloupcová sloučená buňka
    Jednořádková, vícesloupcová sloučená buňka
    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
    Sub SloucenaBunka2AutoFit()

        Dim rngSloucenaBunka As Range
        Dim rngBunka As Range

        Dim astrTextMaxDelka
       
        Dim dblSloucenaBunkaPuvodniSirka As Double
        Dim dblBunka1PuvodniSirka As Double
        Dim dblBunka1PrizpusobenaSirka As Double
        Dim dblBunka1PrizpusobenaVyska As Double
       
        Dim intPocetRadku As Integer
       
        Dim strObsah As String
        Dim strTemp As String

        'aktivace listu pro účely testování
        wshAutoFit.Activate
       
        '****************************
        'Příklad 2
        '****************************

        'reset výšky řádků a šířky sloupců do výchozí podoby
        With ActiveSheet.UsedRange
            .EntireRow.RowHeight = 15
            .EntireColumn.ColumnWidth = 8.43
        End With

        'jednořádková, vícesloupcová sloučená buňka se zalomením
        'Set rngSloucenaBunka = Range("D5:E5")
        Set rngSloucenaBunka = Range("D5").MergeArea

        'výběr sloučené buňky
        rngSloucenaBunka.Select

        'přizpůsobení výšky pouze pro první řádek obsahu
        'rngSloucenaBunka.EntireRow.AutoFit
        'totéž
        'rngSloucenaBunka.Cells(1).EntireRow.AutoFit

        With rngSloucenaBunka
            'celková šířka sloučené buňky
            'v nastavitelných jednotkách (units)
            'ColumnWidth nelze aplikovat přímo na sloučenou buňku
            'pro nestejně široké sloupce vrací Null
            For Each rngBunka In rngSloucenaBunka
                dblSloucenaBunkaPuvodniSirka = dblSloucenaBunkaPuvodniSirka + _
                    rngBunka.ColumnWidth
            Next
            'původní obsah první buňky
            strObsah = .Cells(1).Text
            'původní šířka první buňky oblasti
            'dblBunka1PuvodniSirka = .Cells(1).ColumnWidth
            'zrušení sloučení
            .MergeCells = False
            'a) nastavení šířky první buňky podle původní šířky sloučené buňky
            '.Cells(1).ColumnWidth = dblSloucenaBunkaPuvodniSirka
            'b) přizpůsobení šířky buňky podle její nejdelší textové položky
            'vytvoření řetězce maticové konstanty z obsahu buňky
            strTemp = "={""" & Replace(strObsah, vbLf, """;""") & """}"
            'přidání dočasného definovaného názvu
            ActiveWorkbook.Names.Add Name:="XYZnazev", RefersToR1C1:=strTemp
            'text s maximální délkou (vyhodnocen jako maticový vzorec)
            strTextMaxDelka = _
                Evaluate("=INDEX(XYZnazev,MATCH(MAX(LEN(XYZnazev)),LEN(XYZnazev),0))")
            'odstranění dočasného názvu
            ActiveWorkbook.Names("XYZnazev").Delete
            'nejdelší textová položka (řádek) první buňky jako dočasný obsah
            .Cells(1) = strTextMaxDelka(1)
            'zrušení zalamování
            .Cells(1).WrapText = False
            'přizpůsobení šířky první buňky nejdelší textové položce
            .Cells(1).Columns.AutoFit
            'šířka po přizpůsobení
            dblBunka1PrizpusobenaSirka = .Cells(1).ColumnWidth
            'navrácení původního obsahu
            .Cells(1) = strObsah
            'navrácení zalamování (po vložení textu k němu dojde automaticky)
            .Cells(1).WrapText = True
            'přizpůsobení výšky první buňky
            .Cells(1).Rows.AutoFit
            'výška po přizpůsobení
            dblBunka1PrizpusobenaVyska = .RowHeight
            'znovusloučení
            'nerespektuje nastavenou velikost
            .MergeCells = True
            'nastavení původní šířky a přízpůsobené výšky pro první buňku
            '.Cells(1).ColumnWidth = dblBunka1PuvodniSirka
            'nastavení přizpůsobené šířky a výšky pro první buňku
            .Cells(1).ColumnWidth = dblBunka1PrizpusobenaSirka
            .Cells(1).RowHeight = dblBunka1PrizpusobenaVyska
        End With

    End Sub

    Sešit ke stažení:
    excel-sloucena-bunka.zip

    Uložit článek jako PDF