Jste zde: Úvodní stránka » excel » vba-listy-bunky » bunky-oblasti-excel-vba-kody

Buňky, oblasti - ukázky kódu Excel VBA

Videokurzy Excel

Ve spolupráci se SEDUO jsem vytvořil několik videokurzů:

Jak na Excel - naučte se efektivně využívat Excel - nejoblíbenější (Hodnocení 97%, přes 13.000 studentů, + 750 pozitivních zpětných vazeb) - Získat kurz
MaxiKurz Excel - získejte lepší práci, více peněz, staňte se nepostradatelní (přes 6 hodin videí, 160 lekcí) - Získat kurz
G tabulky... - pokud nemáte rádi Excel využijte kurz na Google-tabulky

práce s buňkami (oblastmi buněk) na základě požadovaných podmínek - počet, barvy, velikost, ...

Aktualizace:1.9.2013

Seznam praktických příkladů

Při práci v Microsoft Excelu je někdy potřeba použít kód pro práci s buňkami. Proč jej vymýšlet a nepoužít hotové - ověřené řešení. V tomto článku jsou praktické ukázky kódu, které tyto problémy řeší:

Spočti barevné buňky - (pozadí) v dané oblasti FUNKCE
Barva pozadí v buňce
Počet buněk určité barvy
Počet shodný buněk s pozadím dané buňky

Každá věc se dá vyřešit několika způsoby. Záleží na požadované rychlosti, zkušenostech s programováním (na co je mi efektní kód kterému nerozumím).

Spočti barevné buňky

Požadavek na funkci, které v označené oblasti spočte buňky, které mají stejnou barvu pozadí jako označená buňka.


Function SpoctiBarvuPozadi(Rng As Range, RngColor As Range) As Integer
    Dim Bunky As Range
    Dim Barva As Long
    Barva = RngColor.Range("A1").Interior.Color
    For Each Bunky In Rng
        If Bunky.Interior.Color = Barva Then
            SpoctiBarvuPozadi = SpoctiBarvuPozadi + 1
        End If
    Next Bunky
End Function

Poznámka: Kód umístit do Modulu.

Do buňky v listu se vloží tato nová uživatelská funkce:

Syntaxe:

=SpoctiBarvuPozadi(oblast;buňka)

Popis argumentů:

oblast - oblast ve které se spočtou buŇky jejiž pozadí vyhovuje barrvě z buňka
buňka - buňka, které pozadí obsahuej heldanou barvu

Příklad použití

V oblasti A1:A4, spočte buňky které mají stejné pozadí jako buňka A1.


=SpoctiBarvuPozadi(A1:A4;A1)

Barva pozadí v buňce

Jak zjistit jakou barvu má pozadí v buňce.


CellColor = Cells(1, 1).Interior.ColorIndex
MsgBox CellColor

CellColor = Cells(1, 1).Interior.ColorIndex MsgBox CellColor

Počet buněk určité barvy

Jak zjistit kolik buněk v dané oblasti má požadovanou barvu.


For a = 1 To 10 Step 1

   If Cells(a, 1).Interior.ColorIndex = 3 Then
     ColorPočet = ColorPočet + 1
   End If
Next a

MsgBox ColorPočet

Počet shodný buněk s pozadím dané buňky

Potřebujeme spočítat počet buněk v zadané oblasti, které mají shodné pozadí jako buŇka A1.


CellColor = Cells(1, 1).Interior.ColorIndex

For A = 1 To 10 Step 1

   If Cells(A, 1).Interior.ColorIndex = CellColor Then
     ColorPočet = ColorPočet + 1
   End If
Next A

MsgBox ColorPočet

Poznámka

Další kódy v přípravě

Závěrem

Pokud máte zajímavý kód o který se chcete podělit, můžete zapsat do komentářů.

Článek byl aktualizován: 19.09.2020 11:06

Odměna

Ušetřil vám tento web čas, peníze? Pomohl vyřešit problém? Jste ochotni poskytnout symbolickou odměnu na další rozvoj? Vybrte si formu odměny, která vám vyhovuje.

Pavel Lasák - autor webu

Microsoft Office (Word, Excel, Google tabulky, PowerPoint) se věnuji od roku 2000 (od 2004 na této doméně) - V roce 2017 jsem od Microsoft získal prestižní ocenění MVP (zatím jsem jediný z ČR v kategorií Excel). Své vědomosti a zkušenosti dávám k dispozici i on-line ve videích pro SEDUO. Ve firmách školím a konzultuji, učím na MUNI. Tento web již tvořím přes 15 let. Zdarma je zde přes 1.000 návodu, tipů a triků, včetně přes 250 různých šablon, sešitů.

Komentáře

Migi

Přidáno: 04.01.14 17:06

Tohle secte hodnoty v bunkach, ktere maji shodnou barvu :) Function soucetbunekstejnebarvy(Rng As Range, RngColor As Range) As Integer Dim Bunky As Range Dim Barva As Long Dim pocet As Integer pocet = 0 Barva = RngColor.Range("A1").Interior.Color For Each Bunky In Rng If Bunky.Interior.Color = Barva Then soucetbunekstejnebarvy = Bunky.Value + soucetbunekstejnebarvy End If Next Bunky End Function

Pavel Lasák

Přidáno: 27.07.14 06:57

To Migi: Díky za doplnění zajímavého a užitečného kódu.

Lukas

Přidáno: 16.09.14 14:19

Udelal sem malou modifikaci vyse zmineneho kodu. Takze treba nekdo hleda neco podobneho, a tak mu to muze pomoct. Jsou to funkce na spocitani barevneho pozadi a barvy fontu podle zadane bunky (rWhatColor). s tim ze se to vykovana na "zvolenem" listu (SheetTarget) "zvoleneho" sesitu (WBName). Function CountInteriorColor(WBName As String, SheetTarget as String, rWhatColor As Range) As Integer Dim LastFullColumn, LastFullRow As Integer Dim rCells, rRange As Range Dim CellColor As Long 'init Workbooks(WBName).Worksheets(SheetTarget).Activate LastFullRow = Workbooks(WBName).Worksheets(SheetTarget).Cells(Rows.Count, 1).End(xlUp).Row Set rRange = Range(Cells(2, 1), Cells(LastFullRow, 1)) CellColor = rWhatColor.Interior.Color For Each rCells In rRange If rCells.Interior.Color = CellColor Then CountInteriorColor = CountInteriorColor + 1 End If Next rCells End Function Function CountFontColor(WBName As String, SheetTarget as String, rWhatColor As Range) As Integer Dim LastFullRow As Integer Dim rCells, rRange As Range Dim CellColor As Long 'init Workbooks(WBName).Worksheets(SheetTarget).Activate LastFullRow = Workbooks(WBName).Worksheets(SheetTarget).Cells(Rows.Count, 1).End(xlUp).Row Set rRange = Range(Cells(2, 1), Cells(LastFullRow, 1)) CellColor = rWhatColor.Font.ColorIndex For Each rCells In rRange If rCells.Font.ColorIndex = CellColor Then CountFontColor = CountFontColor + 1 End If Next rCells End Function

MilanN

Přidáno: 21.09.15 08:17

Ahoj, můžeš mi prosím někdo poradit ? Mám jeden jednoduchý zdrojový sešit , který se mi generuj z webu a má hodnoty jen ve sloupci A. Někdy jsou vyplněny třeba jen 3 buňky jindy třeba 60. Druhý cílový sešit je připravený se vzorci a já potřebuji do jeho sloupce A přidat buňky ze zdrojového sešitu ze sloupce A. Říkal jsem si, že není nic jednoduššího, ale narazil jsem. Já to zkrátka nedokážu. Potřeboval aby ty buňky se do cílového sešitu přidávaly, protože jich je pokaždé jiný počet a kdybych třeba kopíroval víc buněk, narazil bych na konec sloupce, kde mám vzorec pro součet. Já jsem zatím dokázal jen tohle: Workbooks.Open Filename:=Environ("TEMP") & "\Rozpis.xls" 'sem se zapíše sešit vygenerovaný z webu a otevřu ho. Workbooks("Rozpis.xls").Sheets("Rozpis").Select 'tady ho vyberu pocradku = Workbooks("Rozpis.xls").Sheets("Rozpis").Cells(Rows.Count, "A").End(xlUp).Row 'tady si najdu kolik buněk se bude kopírovat Můžeš mi tedy prosím poradit co dál ? Díky