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).

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

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

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í:
sloucena-bunka.zip