MS Excel

Ahoj, snažím se pomocí jednoduchého makra sloučit tři buňky a doplnit text.

Kód je následující:
Sub DoplnPoznamku()

Dim OblastPoznamky As Range 'Oblast poznamky
Set OblastPoznamky = Selection 'Nastaveni mista pro vlozeni tabulky

With OblastPoznamky
.Range("A1:C1").Merge
.Range("A1") = "Poznámka"
.Interior.Color = vbYellow
.HorizontalAlignment = xlCenter
End With

End Sub

Funkce je následující. Vyberu několik buněk, kliknu na tlačítko, vybrané buňky se sloučí s pravými dvěma buňkami, vloží text, obarví pozadí a vycentrují text na střed.

Tohle funguje, ale jen v případě, že vyberu jen jednu buňku. Pokud jich pomocí Ctrl a myši vyberu více, tak to funguje jen u první buňky. Můžete mi prosím poradit, jak to vyladit, aby mohl být výběr buněk vícenásobný?

Zaslat odpověď >

Vovka(19.11.2015 17:48)#028152

Domnívám se, že by mělo stačit, když při vyhodnocení nesouvislé oblasti použijete kolekci Areas:
Dim Oblast As Range, Area as Range, Bunka as Range
For Each Area in Oblast.Areas
For Each Bunka in Area.Cells
naplnění formátů
next Bunka
Next Area
Dokonce si dodatečně myslím, že jednotlivé Areas není nutné porcovat na buňky.citovat

xml(19.11.2015 18:07)#028153

Děkuji za odpověď, ale dělá to stále to samé jako v kódu, který jsem zaslal.
Zkusím ještě probádat Areas, jak píšete.citovat

marjankaj(19.11.2015 18:34)#028154

Keďže netuším, čo presne chceš, tak asi takto

Sub DoplnPoznamku()

Dim OblastPoznamky As Range 'Oblast poznamky
Set OblastPoznamky = Selection 'Nastaveni mista pro vlozeni tabulky
With OblastPoznamky
.Merge
.Value = "Poznámka"
.Interior.Color = vbYellow
.HorizontalAlignment = xlCenter
End With
End Subcitovat

xml(19.11.2015 18:51)#028155

Upřesním to.
Vyberu buňku třeba E4 a po kliknutí na tlačítko makra mi to buňku E4 sloučí se dvěma buňkami vpravo, tzn. E4, F4, G4. Tak to i funguje, kamkoli kliknu myší, tam mi to sloučí tři buňky směrem doprava.

Pokud ale vyberu více buněk, např. E4, D7, A25 pomocí CTRL a myši, tak mi to sloučí pouze buňky E4, F4, G4 a zbylé vybrané buňky to už jen obarví, ale nesloučí to s těmi sousedními, tak jako u buňky, která byla vybrána jako první.citovat

AL(19.11.2015 20:40)#028157

Príliš som to neladil, ale upresnenému zadaniu by mohlo vyhovovať toto:Sub DoplnPoznamkuModified()
Dim OblastPoznamky As Range 'Oblast poznamky
Dim cell As Range, mArea As Range, rReduced As Range, mRng As Range
Set OblastPoznamky = Selection 'Nastaveni mista pro vlozeni tabulky
For Each mArea In OblastPoznamky.Areas
Set rReduced = mArea.Resize(mArea.Rows.Count, 1)
For Each cell In rReduced
Set mRng = Range(cell, cell.Offset(0, 2))
With mRng
.Merge
.Value = "Poznámka"
.Interior.Color = vbYellow
.HorizontalAlignment = xlCenter
End With
Next cell
Next mArea
End Subcitovat

xml(19.11.2015 20:50)#028158

Tohle funguje, super, díky moccitovat

marjankaj(20.11.2015 0:07)#028163

@AL
Viem, že toto nepatrí tebe, ale keď som označil bunky A1;B1;C1, tak mi to trochu divne zlúčilo bunky. No čo už, aj takéto bývajú zadania.

citovat

AL(20.11.2015 0:36)#028165

Jj, toho som si vedomý. Ale vychádzal som zo zadania a z neho Tebou uvedená eventualita priamo nevyplývala. Ošetriť by šla, ale kód by narástol na objeme a nemám istotu, či to nie je zbytočné, keď OP píše, že moje riešenie postačuje.citovat

xml(20.11.2015 16:09)#028193

Tohle je udělátko jenom pro mě, takže že tam není tohle ošetřeno vůbec nevadí.
Navíc se to nikdy nepoužije u buněk vybraných vedle sebe (A1, B1, C1...), ale vždy to bude v jednom sloupci pod sebou.
Ještě jednou díky za řešení.citovat

marjankaj(20.11.2015 16:15)#028195

xml napsal/a:

Tohle je udělátko jenom pro mě, takže že tam není tohle ošetřeno vůbec nevadí.
Navíc se to nikdy nepoužije u buněk vybraných vedle sebe (A1, B1, C1...), ale vždy to bude v jednom sloupci pod sebou.
Ještě jednou díky za řešení.

A toto kto mal vedieť? Mali sme si to vygoogliť? Trochu porozmýšľať na zadaním otázky by nezaškodilo.

citovat

Téma: Vícenásobný výběr a sloučení buněk

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje