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
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).
Celkový počet řádku v sešitě
pocetRadku = Rows.Count
MsgBox pocetRadku
Celkový počet sloupců v sešitě
pocetSloupcu = Columns.Count
MsgBox pocetSloupcu
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.
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ů...
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
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)
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
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
V přípravě
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
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
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
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
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
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
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)
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
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
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
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
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 .
Děkuji za váš čas a doufám, že jste nalezli odpověď na svůj problém.
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.
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.
Pomohl Vám návod? Sdílejte na Facebooku, G+ |
||
LinkedIn... |
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 |