Přeskočit navigaci | Přeskočit na novinky

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

Řádky a sloupce - ukázky kódu Excel VBA

Videokurzy Excel

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

práce s řádky a sloupci na základě požadovaných podmínek - první, poslední, vyhovující podmínce, smazat, vložit, označit...

Aktualizace: 6.3.2013

Seznam praktických příkladů

MS Excel 2010 - tip logo

Při práci s daty v Microsoft Excelu je mnohdy potřeba pracovat s řádky a sloupci (například spočítat, vymazat, najít, označit řádek, nebo sloupec). V tomto članku jsou ukázky kódu, které tyto problémy řeší:


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

Počet řádku / sloupců

Celkový počet řádku v sešitě

pocetRadku = Rows.Count MsgBox pocetRadku

Celkový počet sloupců v sešitě

pocetSloupcu = Columns.Count MsgBox pocetSloupcu

Nalezení prvního prázdného řádku

S použitím cyklu:

For Radek = 1 To 65536 If Cells(Radek, 1) = "" Then 'hledáme ve sloupci A PrvniPrazdnyRadek = Radek Exit For End If Next Radek MsgBox "První prázdný řádek má číslo: " & PrvniPrazdnyRadek End Sub

Lepší VBA kód bez cyklu.

PosledniPlnyRadek = Range("A1").End(xlDown).Row ' Ve sloupci A PrvniPrazdnyRadek = PosledniPlnyRadek + 1 MsgBox "První prázdný řádek má číslo: " & PrvniPrazdnyRadek

Je potřeba ošetřit zda sjou první dva řádky vyplněny například takto:

If Range("A1") = "" Then PrvniPrazdnyRadek = 1 MsgBox PrvniPrazdnyRadek ElseIf Range("A2") = "" Then PrvniPrazdnyRadek = 2 MsgBox PrvniPrazdnyRadek Else PrvniPrazdnyRadek = Range("A1").End(xlDown).Row + 1 MsgBox PrvniPrazdnyRadek End If

Poznámka: Doplněno na základě dotazu v komentáři.

Nalezení posledního obsazeného řádku

Počítat musíme od konce, pokud počítame od začátku, počítaní skončí u prvního prazdného řádku. Ač třeba po pěti prázdných řádcích pokračuje jeden plný.

PosledniPlnyRadek = Cells(Rows.Count, "A").End(xlUp).Row ' Ve sloupci A MsgBox "Poslední obsazený řádek má číslo: " & PosledniPlnyRadek

Pokud poslední řádek obsahuje text, tento kód jej nevezme v potaz. Proto chceteli-mít neprustřelné řešeni nejprve zkontrolujte zda poslední řádek je prázdný. Pokud ano začněte tímto kódem. Mezi námi kdo používá v Excelu tabulky se zaplněným (miliónem) 1.048.576 řádků...

Nalezení prvního prázdného sloupce

použijeme cyklus

If Cells(1, Sloupec) = "" Then 'hledáme v řádku 1 PrvniPrazdnySloupec = Sloupec Exit For End If Next Sloupec MsgBox "První prázdný sloupec má číslo: " & PrvniPrazdnySloupec

Lepší VBA kód bez cyklu.

PrvniPrazdnySloupec = Range("A1").End(xlToRight).Column ' řádek 1 PrvniPrazdnySloupec = PrvniPrazdnySloupec + 1 MsgBox "Pprvní prázdný sloupec má číslo: " & PrvniPrazdnySloupec

Nalezení posledního zaplněného sloupce

Jako u řádků počítáme od konce.

PosledniPlnySloupec = Cells(1, Columns.Count).End(xlToLeft).Column ' Ve sloupci A MsgBox "Poslední obsazený sloupec má číslo: " & PosledniPlnySloupec

Jako u řádků, doporučuji kontrolu zda je poslední sloupec obsazen. Tj. Sloupec číslo 16384 (XFD)

Nalezení poslední obsazené buňky

VBA kod zjistí poslední obsazenou buňku a v případě, informuje o tom že list je úplně prázdný.

Dim PosledniSloupec As Integer Dim PosledniRadek As Long If WorksheetFunction.CountA(Cells) > 0 Then PosledniRadek = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row PosledniSloupec = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column MsgBox ("Poslední obsazena buňka má řádek: " & PosledniRadek & " sloupec: " & PosledniSloupec) Else MsgBox ("Prázdný list") End If

Označení řádků splňujících podmínku

Může fungovat i jako kopírování na další List (sešit)

Dim PosledniRadek As Long, i As Long Dim OznacOblast As Range With Sheets("List1") PosledniRadek = .Range("A" & .rows.Count).End(xlUp).Row For i = 1 To PosledniRadek If Len(Trim(.Range("A" & i).Value)) <> 0 Then If OznacOblast Is Nothing Then Set OznacOblast = .rows(i) Else Set OznacOblast = Union(OznacOblast, .rows(i)) End If End If Next If Not OznacOblast Is Nothing Then ' tato oblast se může zkopírovat ... OznacOblast.Copy Sheets("List2").Rows(1) OznacOblast.Select End If End With

Označení sloupců splňujících podmínku

V přípravě

Smazání prázdných řádku

Kontroluje zda ve sloupci A jsou samostatné prázdné řádky, pokud ANO, tak je smazán.

' pro určení odkud kam můžeme použít předcházející kódy ' já jsem použil pro jednoduchost konstanty For i = 30 To 27 Step -1 If StrComp("", Cells(i, "A").Value) = 0 Then MsgBox i Rows(i).Delete End If Next i

Pokud je více řádku prázdných za sebou, díky za námět v komentářích.

For i = 30 To 10 Step -1 If StrComp("", Cells(i, "A").Value) = 0 Then MsgBox i Rows(i).Delete End If Next i

Smazání řádku splňujících podmínku

Kontroluje zda ve sloupci A je řádek obsahující text "smazat", pokud ANO, tak je smazán.

For i = 30 To 27 Step -1 If StrComp("smazat", Cells(i, "A").Value) = 0 Then MsgBox i Rows(i).Delete End If Next i

Další možný kód

Set rng = Range("A1:A10") i = 1 For counter = 1 To rng.Rows.Count If rng.Cells(i) = "smazat" Then rng.Cells(i).EntireRow.Delete Else i = i + 1 End If Next

Smazání každého x-tého řádku

Smaže každý x-tý řádek v zadané oblasti.

N = 2 Set DeleteRange = Range("A1:D20") If DeleteRange Is Nothing Then Exit Sub If DeleteRange.Areas.Count > 1 Then Exit Sub If N < 2 Then Exit Sub With DeleteRange rCount = .Rows.Count For r = N To rCount Step N - 1 .Rows(r).EntireRow.Delete Next r End With

Smazání každého x-tého sloupce

Smaže každý x-tý sloupec v zadané oblasti.

N = 2 Set DeleteRange = Range("A1:D10") Dim cCount As Long, c As Long If DeleteRange Is Nothing Then Exit Sub If DeleteRange.Areas.Count > 1 Then Exit Sub If N < 2 Then Exit Sub With DeleteRange cCount = .Columns.Count For c = N To cCount Step N - 1 .Columns(c).EntireColumn.Delete Next c End With

Smazání prázdných sloupců

Smaže sloupce které v zadané oblasti mají prázdný buňku v prvním řádku prázdnou.

Set Rng = Range("A1:K1") i = 1 For counter = 1 To Rng.Columns.Count If Rng.Cells(i) = "" Then Rng.Cells(i).EntireColumn.Delete Else i = i + 1 End If Next

Smazání sloupců splňujících podmínku

Smaže sloupce splňující podmínku že v obsahují v prvním řádku text smazat.

Set Rng = Range("A1:G1") i = 1 For counter = 1 To Rng.Columns.Count If Rng.Cells(i) = "smazat" Then Rng.Cells(i).EntireColumn.Delete Else i = i + 1 End If Next

Řádek s maximální/minimální hodnotou

Najde v řádku maximální hodnotu a vrátí číslo tohoto řádku

MaxHodnota = Application.WorksheetFunction.Max(Range("B:B")) MsgBox (MaxHodnota) For Row = 1 To 65536 If Range("B1").Offset(Row - 1, 0).Value = MaxHodnota Then Range("B1").Offset(Row - 1, 0).Activate MsgBox "Maximální hodnota je na řádku: " & Row Exit For End If Next Row ' zobrazí jen první max hodnotu (pokud jsou dvě max hodnoty)

Najde v řádku minimální hodnotu a vrátí číslo tohoto řádku

MinHodnota = Application.WorksheetFunction.Min(Range("B:B")) MsgBox (MinHodnota) For Row = 1 To 65536 If Range("B1").Offset(Row - 1, 0).Value = MinHodnota Then Range("B1").Offset(Row - 1, 0).Activate MsgBox "Minimální hodnota je na řádku: " & Row Exit For End If Next Row ' zobrazí jen první min hodnotu (pokud jsou dvě min hodnoty)

Skrýt/zobrazit řádky/sloupce

Předpokládám, že je vybraný požadovaný řádek (sloupec), který chcete skrýt.

' skrýt sloupce Range("A:C").Columns.Hidden = True ' zobrazit sloupce Range("A:C").Columns.Hidden = False ' skrýt řádky Range("11:15").Rows.Hidden = True ' zobrazit řádky Range("11:15").Rows.Hidden = False

Skrýt/zobrazit řádky/sloupce - verze 2

Předpokládám, že je vybraný požadovaný řádek (sloupec), který chcete skrýt.

' skrýt sloupce Selection.EntireColumn.Hidden = True ' zobrazit sloupce Selection.EntireColumn.Hidden = False ' skrýt řádky Selection.EntireRow.Hidden = True ' zobrazit řádky Selection.EntireRow.Hidden = False

Stav řádku sloupce (skrytý?)

Obdržíme informace zda je řádek skrytý (TRUE) či zobrazený (FALSE).

stav = Range("15:15").Rows.Hidden MsgBox stav stav = Range("A:A").Columns.Hidden MsgBox stav

Poznámky

Budete-li zpracovávat milióny řádku předpokládám, můžete si nastudovat složitější metody SpecialCells, AutoFilter atd., případně použijete databázi.

Kódy lze napsat i efektivněji (tj. pracuji rychleji). Pro pár tisíc řádku rychlost výše uvedených kódu postačí, postačí i pro několik desítek tisíc řádku. V porovnání s ručním zpracováním jsou všechny výše uvedené kódy efektivnější (a navíc pracují bezchybně, oproti lidskému faktoru). Místo zpracovávání desítky hodin člověkem to kód zvládne v několika sekundách (minutách).

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

Podpora - oceňte web a pozvěte mě na čokoládu

Pomohl vám článek? Vyřešili jste problém? Můžete mě podpořit zakoupení tabulky (samozdřejmě čokoládové), když kafe nepiji ;) Odkaz na zakoupení čokolády. Za veškerou podporu vám děkuji a samozdřejmě jí využiji do zdokonalování a rozšířování webu.

Případně přidejte odkaz na vaši oblíbenou sociální síť, případně využijste hashtag #JakNaExcel .

Poděkování

Děkuji za váš čas a doufám, že jste nalezli odpověď na svůj problém.

Vylepšení

Narazili jste v článku na nejasnost, chybu? Máte tip na vylepšení nebo doplnění článku? Budu rád pokud se zmínite v komentářích.


Pavel Lasák - autor webu

Pavel Lasák

Microsoft Office (Word, Excel, Google tabulky, PowerPoint) se věnuji od roku 2000 (od dubna roku 2004 na této doméně) - V roce 2017 jsem od Microsoft získal prestižní ocenění MVP (zatím 8x za sebou). 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 20 let (o Excel píší přes 25). Zdarma je zde přes 1.500 návodu, tipů a triků, včetně přes 350 různých šablon, sešitů a přes 70 taháků v pdf.

   Pavel Lasák LinkedIn Profil    Pavel Lasák twitter Profil




Excel


Sdílejte

Pomohl Vám návod?
Sdílejte na Facebooku, G+
LinkedIn...

Nové články


Reklama


TOPlist Licence Creative Commons webarchiv rss XML

Stránky o MS Office (Excel) produktu společnosti Microsoft. Neslouží jako technická podpora.
| Email na autora: pavel.lasak@gmail.com | Copyright © : Pavel Lasák 2004 - 2025 |