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: 01.11.2014 14:17

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

Pavel Lasák

Microsoft Office (Word, Excel, PowerPoint) se věnuji od roku 2000 (od 2004 ne této doméně) - Roku 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 také na on-line videích pro SEDUO. Školím a konzultuji, učím na MUNI. Hlavně tvořím tento web. Je zde k dispozici přes 1.000 návodu, tipů a triků včetně stovek různých šablon, sešitů.

   Pavel Lasák LinkedIn Profil    Pavel Lasák Google+ Profil    Pavel Lasák facebook Profil    Pavel Lasák twitter Profil


Komentáře


Vlastimil

Přidáno: 28.05.12 14:32

Zdravím a díky za skvělé stránky. Trochu jsem experimentoval a vymyslel jsem kód, který zjistí naprosto korektně, jestli je sloupec prázdný, nebo ne. obsazenych_bunek = Sheets("List1").Columns("K:K").cells.count - Sheets("List1").Columns("K:K").SpecialCells(xlCellTypeBlanks).count

Pavel Lasák

Přidáno: 29.05.12 18:51

To Vlastimil: díky za kód určitě se bude někomu hodit.

Tomas

Přidáno: 05.06.12 20:19

Zdravím, prosím o radu jak napsat příkaz pro: Nalezení prvního prázdného řádku, a umístění do něho kurzor (jako když do něj kliknete myší) a možnost něco vepsat. Děkuji o radu

Pavel Lasák

Přidáno: 07.06.12 20:46

To Tomáš: Pomocí SELECT PosledniPlnyRadek = Range("A1").End(xlDown).Row ' Ve sloupci A PrvniPrazdnyRadek = PosledniPlnyRadek + 1 Cells(PrvniPrazdnyRadek, 1).Select Poznámka nezapomenout ošetřit pokud bude poslední řádek obsahovat záznam, případně celý sloupec bude prázdný.

Míra

Přidáno: 20.11.12 10:36

Dobrý den, prosím o pomoc, jak vložit hodnotu z libovolné buňky jako kriterium do filtru,viz makro9... Bohužel tak jak to je napsáno, to nefunguje! Předem mnohokrát děkuji! Sub Makro9() ' ' Makro9 Makro ' Range("D10").Select ActiveCell.FormulaR1C1 = InputBox("zadejte KKS") ActiveSheet.Range("$C$11:$H$3002").AutoFilter Field:=5, Criteria1:= _ "=D10" End Sub

Arno

Přidáno: 06.01.13 11:46

Označení řádků splňujících podmínku Dobrý den, tak jste na tom? Na tomto místě jsem se zaseknul a nevím jak dál. Poradíte? Děkuji hahn

Pavel Lasák

Přidáno: 06.01.13 19:48

To Arno: Označí neprazdné řádky dle sloupce A 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.Select End If End With

Jirka

Přidáno: 07.01.13 20:44

Dobry den, prosim o radu - mam nasledujici problem: Ve sloupci B hledam cislo radku, kde je min. a max. hodnota. Thisworkbook.worksheets("list1").cells(1,1).Activate Dim x, y As Variant Do Until ActiveCell.value = "" sheets("list1).cells(activeCell.row+1,1).Activate Set x = cells.Find(What:=Application.WorksheetFunction.Min(Columns("B")), After:=ActiveCell, LookIn:=xlValues, LookAt:= _ xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , SearchFormat:=False) y = x.Row Loop MsgBox "y=" & y Kdyz takto zapisu kod, tak pro MIN mi to bezproblemu funguje. Kdyz ale misto MIN prepisu MAX, tak to padá - nevíte v čem by mohl byt problem? Děkuji

Jarda

Přidáno: 08.02.13 20:24

Zdravim, rad bych poprosil o polmoc: Potreboval bych, aby excel pri splneni podminky ve sloupci E (samostatne makro: ActiveCell.FormulaR1C1 = "=(TODAY()-DAY(TODAY()))-(DAY(TODAY()-DAY(TODAY())))+1") umazal kompletni radky, ktere jsou mladsi nez uvedene datum. nevim jak zadat podminku vyse uvedenou za "case is" pokud se tam vlozi napr pismeno a - tak vse funguje - ale nemuzu tam dostat vzorec. Jsem zacatecnik tak se omlouvam. Diky Sub smazat_radky() Dim Firstrow As Long Dim Lastrow As Long Dim Lrow As Long Dim CalcMode As Long Dim ViewMode As Long With Application CalcMode = .Calculation .Calculation = xlCalculationManual End With With ActiveSheet .Select ViewMode = ActiveWindow.View ActiveWindow.View = xlNormalView .DisplayPageBreaks = False Firstrow = .UsedRange.Cells(1).Row Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row For Lrow = Lastrow To Firstrow Step -1 With .Cells(Lrow, "E") ' Sloupec s hledanými podmínkami If Not IsError(.Value) Then Select Case .Value Case Is = "co tady mam doplnit????": .EntireRow.Delete 'podmínka v uvozovkách End Select End If End With Next Lrow End With ActiveWindow.View = ViewMode With Application .Calculation = CalcMode End With End Sub

Pavel Lasák

Přidáno: 09.02.13 07:55

To Jirka: Já používám pro MAX, MIN toto: 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) jinak v zaslaném kódu jsou dvě chyby (uvozovky " a sloupce je 2) Sheets("list1").Cells(ActiveCell.Row + 1, 2).Activate

Martin

Přidáno: 28.02.13 10:07

ahojte potreboval by som makro ktore mi ak sa zmeni hodnoty bunky voci bunke nad nou aby mi vlozilo /skopirovalo/ prva 2 riadky tabulky. Tam je vlastne hlavička. Potrebujem akoby rozkuskovat tabulku, ak sa zmeni hodnota potrebujem tam vlozit hlavicku

Josef

Přidáno: 02.03.13 17:44

Prosím o pomoc programuji ve VBA a přeposílám data v txt souborech přes mail. Při načtení a zpracování, mám problém s převodem datumu... Je totiž uložen jako string např. "01.02.2013" zkoušel jsem to i přes datevalue(), ale je to nespolehlivé. V Excelu 2007 to nakonec běží, ale v Excelu 2010 to zase kolabuje. děkuji za pomoc

Pavel Lasák

Přidáno: 03.03.13 17:06

To Josef: Viz například http://stackoverflow.com/questions/11833114/excel-vba-import-txt-file-with-variable-column-width

colmic 11

Přidáno: 25.03.13 13:33

Prosím o pomoc, použil jsem příkaz pro označení prvního volného řádku viz PosledniPlnyRadek = Range("A1").End(xlDown).Row ' PrvniPrazdnyRadek = PosledniPlnyRadek + 1 Cells(PrvniPrazdnyRadek, 1).Select funkce mi skvěle funguje, pokud mám ve sloupci A alepsoň 2 řádky,pokud mám jen jeden ( v A1), tak mi to hází chybu. Jde to nějak ošetřit,aby to fungovalo i když tam mám pouze hodnotu v poli A1, Předem moc díky

Pavel Lasák

Přidáno: 25.03.13 20:10

To colmic 11: Nejprve zkontrolovat, zda jsou první 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

Dan

Přidáno: 16.04.13 20:03

Dobrý den, prosím o pomoc s následujícím kódem Sub dolu() Dim adresa As String Dim radek As String Dim sloupec As String Dim cil As String adresa = Sheet1.Range("A1").Value radek = Right(adresa, 1) sloupec = Left(adresa, 1) radek = CInt(radek) radek = radek + 1 radek = CStr(radek) cil = sloupec + radek Sheet1.Range(adresa).Select Sheet1.Range(adresa).Copy Sheet1.Range(cil).Select Sheet1.Range(cil).PasteSpecial Sheet1.Range(adresa).Clear Sheet1.Range("A1") = cil End Sub Jedná se o součást školního projektu - hry. K´´od slouží pro posunutí "figurky" dolů. Problémem je, že když je "figurka" např. na políčku H10, tak při spuštění funkce se neposune na políčko H11 ale skočí na políčko H1. Proč se 10+1 = 1? Děkuji, Dan

Pavel Lasák

Přidáno: 16.04.13 20:35

To Dan: Dělá to řádek radek = Right(adresa, 1) Pokud si to odkrokuješ (např. za tento kód přidej) MsgBox (radek) Uvidíš zvyšování 1, 2, 3 .... 9, ale do radek se načte první znak zprava což je 0 (ač v A1 bude např. H10) a k té se přičte 1 takže kód funguje správně 1(0+1) je 1. Podobné to bude i pro sloupec.
Snad je můj výklad pochopitelný.

Pesk

Přidáno: 30.04.13 13:25

Ahoj, prosím o radu, jak zjistit číslo řádku aktivní buňky (ActiveCell), neboli její druhou souřadnici. Řádek vybere uživatel kliknutím na libovolnou buňku a já potřebuji načíst do proměnné hodnotu z 1. sloupce (A) z tohoto řádku. Díky. PS: děkuji za studnu informací, nejednou mi pomohla. ;-)

Ales

Přidáno: 03.05.13 15:35

Ahoj, prosim o radu jak ocislovat jen viditelne radky vybrane pomoci makra filtrem postupne 1,2,3,... atd. Pokud zmenim filtr serazeni bude jine, ale poradi potrebuji zase priradit 1,2,3 ... Diky moc za radu

Pavel Lasák

Přidáno: 03.05.13 16:18

To Pesk: Například: Sub AktivniBunka() MsgBox "Aktivní buňka je v řádku: " & ActiveCell.Row MsgBox "Aktivní buňka je v sloupci: " & ActiveCell.Column End Sub

Pavel Lasák

Přidáno: 04.05.13 16:59

To Ales: Například cyklem ve kterém se zjišťuje, zda je řádek skrytý, pokud není zapsat i+1 stav = Range("15:15").Rows.Hidden MsgBox stav skrytý řádek = TRUE

Katka

Přidáno: 29.06.13 02:25

Dobrý den všem, potřebovala bych pomoct s následujícím kódem, který mi data ze všech sešitů přenese do aktivního sešitu. Tak jak to mám v současnosti mi je to však všechny naskládá pod sebe, což nechci - potřebuji aby se všechny naskládaly za sebe (vedle sebe). Mohla by se na to moc prosím nějaká chytrá hlava podívat a změnit mi ten kód. Bohužel nejsem programátor a asi se s tím nepoperu - už jsem sama zkoušela, ale nedělá to co má. Sub MergeSheets() Dim SrcBook As Workbook Dim fso As Object, f As Object, ff As Object, f1 As Object Application.ScreenUpdating = False Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.Getfolder("C:\Users\Katka\Documents\PROCESSED\F2\3_Metronom") Set ff = f.Files For Each f1 In ff Set SrcBook = Workbooks.Open(f1) Range("A1:IV" & Range("A65536").End(xlUp).Row).Copy ThisWorkbook.Worksheets(1).Activate Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Application.CutCopyMode = False SrcBook.Close Next End Sub

Miloš

Přidáno: 17.07.13 12:39

Dobrý den, řeším problém s automatickým nastavením výšky sloučených buněk v řádku podle obsaženého textu. Pomocí formuláře z textboxu ukládám delší text, který se ve sloučené buňce zalomí, ale výška řádku se nezmění. Lze toto nastavit po zapsání do buňky pomocí makra? Předem mnohokrát děkuji. PS: Máte úžasný web, veliká poklona.

Lukáš

Přidáno: 25.07.13 17:19

Dobrý den, s VBA začínám (mj. i díky tobě) a nedaří se mi vytvořit program, který by našel první volnou buňku ve sloupci G a zapsal do ní údaj z jiného sešitu. Použil jsem tvoji variantu: PosledniPlnyRadek = Range("G1").End(xlDown).Row ' Ve sloupci A PrvniPrazdnyRadek = PosledniPlnyRadek + 1 A teď nevím, jak dál... Díky Lukáš

Pavel Lasák

Přidáno: 26.07.13 09:51

To Miloš: Například využít WrapText, EntireRow.AutoFit: ActiveWorkbook.Worksheets("List1").Range("B2").WrapText = True ActiveWorkbook.Worksheets("List1").Range("B2").EntireRow.AutoFit

Pavel Lasák

Přidáno: 26.07.13 10:11

To Lukáš: Vkládání jsem popsal v článku: Jak zapisovat údaje do buněk

PetP

Přidáno: 30.09.13 10:27

Mam stejny problem jako Milos, vkladam pomoci tohoto kodu: Dim Sesit As Worksheet set sesit ............. Sesit.Range("B22").WrapText = True Sesit.Range("B22").EntireRow.AutoFit Sesit.Range("B22") = note kde note je string z textboxu (pouzivam "Lorem ipsum ....... Bunky se slouci, text se zapise, vyska radku zustava stejna - dokaze nekdo pomoci.

Pekox

Přidáno: 05.01.14 22:51

Ako nahradit parametricky cisla riadkov napr. vo vzorci =SUM(C5:C8) tak, ze cisla riadkov (5 a 8) budem mat uvedene osobitne napr. v bunkach A1 a A2, kde ich mozem flexibilne menit a priamo do vzorca "=SUM(...)" sa mi budu automaticky dosadzovat ine a ine cisla riadkov rozsahov podla toho, ake hodnoty zapisem do buniek A1 a A2 ? pekox@seznam.cz

Martin

Přidáno: 21.02.14 19:41

Ahoj, prosím o pomoc: Potřebuju, aby mi makro vložilo do sloupce A funkci zleva (b1;8) a to do všech řádků až do čísla posledního řádku sloupce B. Napsal jsem si toto: Sub Napis() For i = 1 To PosledniPlnyRadek PosledniPlnyRadek = Cells(Rows.Count, "A").End(xlUp).Row Range("A1:A & PosledniPlnyRadek").FormulaLocal = "=zleva(b1;8)" Next i End Sub Ale nefunguje. Prosím o pomoc. martin-hrncir@seznam.cz

Daniel

Přidáno: 13.03.14 11:23

Ahoj. Zacal jsem trochu zkouset makra v excelu. Mam takovy problem, ze nevim jak dostat do fukce range promenou, ktera se drive ve funkci zapise. Sub Rdk() For Radek = 12 To 65536 If Cells(Radek, 7) = "0" Then 'hledáme ve sloupci G Psd = Radek Exit For End If Next Radek Range("Psd:120").Rows.Hidden = True End Sub Potreboval bych aby se do toho range dostaly radky, ktere jsou zapsany ve funkci. Díky za rady, nebo odkazy na materiály, které bych měl prostudovat.

Daniel

Přidáno: 15.03.14 09:31

Nastavil jsem MojeRange jako String a hodnotu zapsal, potom jenom Range(MojeRange).Rows.Hidden = True Diky za stranky:)

willyboy

Přidáno: 05.04.14 16:46

Ahoj, ja som našiel chybičku v makre na vymazanie prázdneho riadku. Ide o to, že keď máš za sebou 2 prázdne riadky, tak vymamžeš i-tý, ale ten i+1 sa z neho stane vymazaním predošlého znova i-tý a ty v cykle zvyšuješ i a tým ho vlastne preskočíš. Pridal som len zníženie hodnoty po každom vymazaní riadku. Tým je to OK. Ináč, vlastne tým vzorcom ani nerozumiem. Keby som tak mohol od Teba dostať školenie. Pa. For i = 30 To 27 Step -1 If StrComp("", Cells(i, "A").Value) = 0 Then MsgBox i Rows(i).Delete i=i-1 End If Next i

Pavel Lasák

Přidáno: 07.04.14 17:00

To willyboy: Díky za postřeh. Upřesnil jsem informaci u kódu, že jde o mazaní osamocených řádků. Plus přidal tvůj kód pokud je prázdných řádku více. Jen jsem z kódu umazal i=i-1, tento řádek je navíc. Kód nesmí obsahovat, aby fungovalo jak má: For i = 30 To 10 Step -1 If StrComp("", Cells(i, "A").Value) = 0 Then MsgBox i Rows(i).Delete End If Next i

Georgino

Přidáno: 28.05.14 08:05

Ahoj, díky za tyto stránky, moc mi pomohly. Teď řeším: Po vyplnění formuláře se zadaná data zapíší do listu tak, že makro malezne poslední neobsazený řádek a data zapíše do něho, do každého sloupce jednotlivá data vybraná v comboboxech ve formuláři. Potřeboval bych, aby se mě jednotlivé záznamy číslovaly, to znamená potřebuji makro, které by přečetlo pořadové číslo předchozího záznamu a poté do aktuálního řádku na poslední sloupec zadalo číslo předchozího +1. Problém podle mě je ten, že předem neznám adresu předchozí buňky. Moc děkuji za pomoc.

Michal

Přidáno: 13.06.14 13:34

Ahoj, díky za skvělé stránky jež jsou i pro mě inspirací. Chvilku jsem se trápil s nalezením prvního a posledního řádku v označené oblasti. Nakonec jsem na to snad přišel. Níže uvádím kód, třeba se to bude někomu hodit. PrvniPlnyRadek = ActiveCell.Row PosledniPlnyRadek = Range("D" & PrvniPlnyRadek).End(xlDown).Row

Jojo

Přidáno: 10.07.14 08:54

To Michal: Uvedený kód je OK iba ak je ActiveCell.Row < PosledniPlnyRadek

Jojo

Přidáno: 10.07.14 09:54

To Georgino: viď podnadpis "Nalezení posledního obsazeného řádku" (od Pavel Lašák) -- včetne poznámky + dopĺňam pre starší Exc2003 je problém s riadkom 65536

Jojo

Přidáno: 10.07.14 11:58

To Michal: (pokračujem) ... + navyše pre zistenie posledného riadku by museli byť vyplnené všetky bunky v danom stĺpci("D") od PrvniPlnyRadek až po PosledniPlnyRadek -- + pre PrvniPlnyRadek(okrem prvého) by som použil: -- PrvniPlnyRadek = Range("A1").End(xlDown).Row

Petr

Přidáno: 24.07.14 21:46

Zdravím, vytvářím v excelu formulář a potřeboval bych poradit s makrem, které by bylo součástí ovládacího prvku (číselník) a dle hodnoty čísleníku vložil příslušný počet řádků tabulky. Počet řádků by se zároveň měl měnit v závislosti na hodnotě číselníku. Díky

Petr

Přidáno: 24.07.14 21:55

Zdravím, vytvářím v excelu formulář a potřeboval bych poradit s makrem, které by bylo součástí ovládacího prvku (číselník) a dle hodnoty čísleníku vložil příslušný počet řádků tabulky. Počet řádků by se zároveň měl měnit v závislosti na hodnotě číselníku. Díky

Petr

Přidáno: 31.07.14 20:02

Zdravím, mám ještě jeden dotaz. Potřeboval bych makro, které by vložilo do tabulky o x řádcíh další řádky dle hodnoty uvedné v poslední buňce řádku/sloupce. Díky

Jacck

Přidáno: 20.09.14 13:01

Zdravím, potřebuji zjednodušit kód: ws.Cells(iRow, 1).Value = "Text" ws.Cells(iRow, 2).Value = "Text" ws.Cells(iRow, 3).Value = "Text" ws.Cells(iRow, 4).Value = "Text" ws.Cells(iRow, 5).Value = "Text" na něco jako: ws.Cells(iRow, (1:5)).Value = "Text" -> což nefunguje Děkuji

Jacck

Přidáno: 21.09.14 19:30

Zdravím, malá oprava příspěvku výše. Nepotřebuji vložit do "5ti" buněk v řadě stejný text, ale potřebuji všech pět buněk mít v jednu chvíli označených. 1) Kvůli hromadnému formátování ale hlavně 2) Kvůli jejich sloučení Vztahuje se to k příkladu: Nalezení prvního prázdného řádku a následně jeho úpravu 1) nebo 2) podle podmínky. Zkoušel jsem použít příklad Označení řádků splňujících podmínku, ale nějak jsem se v tom zamotal. Děkuji za pomoc

Jacck

Přidáno: 21.09.14 20:44

Pro případné zájemce. Nevím, zda neexistuje více řešení, ale těsně po předchozím příspěvku jsem nalezl tento kód: Range(Cells(iRow, 1), Cells(iRow, 6)).Select Který uspokojil všechny mé potřeby. PS: Omlouvám se za SPAM

Osvald

Přidáno: 17.12.14 15:31

Dobrý den, potřebuji poradit, jak v listboxu nezobrazit skryté řádky

Kamila

Přidáno: 14.01.15 20:57

Dobrý den, potřebovala bych poradit se zadáním funkce do tabulky (konkrétně se jedná o peněžní deník). Chtěla bych, aby se po zadání typu transkace do 1. sloupce (konkrétně D, nazvaný Transakce) automaticky doplnilo do 2. sloupce (konkrétně E, nazvaný Pořadí) pořadové číslo daného typu transakce. Typy transakcí jsou nikoli překvapivě P (příjem) nebo V (výdaj). Pokus o slovní popis toho, co by měla daná funkce dělat: pokud na aktuálním řádku hodnota ve sloupci D (Transakce) = "P", najdi ve sloupci E (Pořadí) hodnotu předchozí položky, pro kterou platí D="P" a k ní přičti 1, jinak najdi ve slolupci E (Pořadí) hodnotu předchozí položky, pro kterou platí D="V" a k ní přičti 1... Zdá se, že vyhledat buňku s maximální hodnotou až takový problém není, jen to neumím zkombinovat s filrem (resp. ověřením podmínky) P/V v předchozím sloupci, ani nastavit pro výpočet, excel mám dost ráda, ale s VBA si bohužel zatím netykám... Ještě pro upřesnění - 1. položka v jakémkoli roce bude vždy typu "P", další položky mohou nabývat hodnot P nebo V libovolně, podle toho, jak jde život, proto je v testu nastaveno nejpve vyhledání předchozího "P"... Děkuju moc za případnou radu.

Jojo

Přidáno: 19.01.15 09:01

To Kamila: -- Keďže, z uvedeného popisu rozumiem tak, že čísla narastajú(nasledujúce číslo nikdy nie je menšie ako boli predchádzajúce), tak pri zadaní "P" testovať predchádzajúci riadky dovtedy, pokiaľ nenájde "P". Ak áno pripočítať +1. (Pre "V" podobne.)

Jojo

Přidáno: 20.01.15 07:25

To Kamila: -- dalo by sa to riešiť aj s dvomi pomocnými bunkami, kde by boli vždy uložené max hodnoty pre "P" a "V"

Kamila

Přidáno: 25.01.15 15:34

2 Jojo: děkuju za tip, tuším, že něco takového asi budu muset zadat, ale absolutně nevím jak, VBA fakt neumím a jen pomocí funkcí to asi nepůjde. Jestli se tu něco typově podobného řešilo, ráda si to načtu, ale vůbec nemám ponětí, kde to případně hledat. V každém případě ještě jednou díky.

Jojo

Přidáno: 27.01.15 13:13

To Kamila: -- Bez VBA by ešte mohlo byť nasled.neúplné riešenie riešenie: -- Napísať: --do F1->"Vložené", G1->"MaxPreVložené", F2-> =POLÍČKO("contents"), a teraz POZOR do G2-> =MAX(($D$2:$D$10=$F2)*($E$2:$E$10)), ALE cez CTRL+SHIFT+ENTER(nie iba samotné ENTER). Ak sa všetko zadalo správne, tak by sa po zadaní písmena "P" alebo "V" v F2 objaví obsah poslednej zadanej bunky("P" alebo "V") a v G2 doterajšie maximum pre ("P" alebo "V"). Opakujem je to neúplné riešenie, lebo k tejto hodnote treba pripočítať +1 aručne zapísať do stĺpca "D"(Transakce).

PetrK

Přidáno: 04.03.15 10:30

Dobrý den, Prosím o radu - mám tabulku, ve sloupci A hledám určitý znak, když ho najdu potřebuji od tohoto znaku smazat celou oblast dolu. Děkuji za pomoc. Petr

Abra

Přidáno: 18.03.15 12:22

Dobrý den, řeším situaci, kdy potřebuji zkopirovanou hodnotu aktuální buňky vložit jako kritérium do filtru. Makro se mi nahrálo takto: Sheets("List2").Select Selection.Copy Sheets("List1").Select ActiveSheet.Range("A1:A1752").AutoFilter Field:=10, Criteria1:= _ "123" Já bych potřebovala, aby místo té konkrétní hodnoty "123" bylo kritérium aktuálně zkopírovaná hodnota buňky. Moc děkuji :-)

Tomáš

Přidáno: 23.04.15 12:47

Dobrý den, potřeboval bych poradit s makrem. Příklad: v sloupci A mám zaškrtávací políčka, v sloupci B mám jména a v sloupci C mám věk. Potřeboval, aby poté, co zaškrtnu některá políčka v sloupci A, tak se mi na dalším listu v excelu vytvoří seznam se jmeném a věkem (které jsou ve stejném řádku jako zaškrtnuté políčko). Děkuji za pomoc. Byl bych rád, kdyby jste mě kontaktovali na toceli@seznam.cz. děkuji

Michael

Přidáno: 05.08.15 16:10

Zdravím, jak prosím upravit toto makro na označení řádků splňujících podmínku, tak aby mi označil pouze určité buňky (konkrétně v rozsahu sloupců E:H)? Mockrát děkuji za pomoc. Michael 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

Pavel

Přidáno: 23.11.15 11:03

ZDravim, u kodu "PosledniPlnyRadek = Range("A1").End(xlDown).Row PrvniPrazdnyRadek = PosledniPlnyRadek + 1 Cells(PrvniPrazdnyRadek, 1).Select" je ten problem,ze pokud je databaze, nahore je jeden radek ve kterem jsou popsany jednotlive sloupce a druhy radek je tedy prazny,makro se zastavi na poslednim tretim radku makra :"Cells(PrvniPrazdnyRadek, 1).Select" Aby to fungovalo, musi byt prvni radek databaze vyplneny, da se to nejak elegantne vyresit? Dekuji

Lukas

Přidáno: 20.12.15 21:13

Zdravím, mám dotaz, jestli je možné ukotvit řádky/sloupce pomocí makra, případně jak. Děkuji

Kedus

Přidáno: 23.12.15 09:23

Ahojte, vie mi niekto poradiť prečo mi toto nefunguje v exceli 2013? Set Rng = Range("A13:A42") i = 1 For counter = 1 To Rng.Rows.Count If Rng.Cells(i) = "zmazať" Then Rng.Cells(i).RowHeight = 0 i = i + 1 Else: Rng.Cells(i).RowHeight = 15 Rows.AutoFit i = i + 1 End If Next Vo verzii 2010 som na tom fungoval v pohode ...

Tomáš

Přidáno: 02.02.16 04:47

Nemělo by "Next" říkat i které proměnné se týká? "Next counter"

Jakub

Přidáno: 02.02.16 15:13

Dobrý den, potřeboval bych pomoc s problémem. Přes inputbox zadám položku a chci, aby mi makro vymazalo všechny řádky, kde se položka nevyskytuje. Děkuji

Ondrej

Přidáno: 02.03.16 17:27

Dobrý deň, chcel by som si napísať skript na to že chcem skryť riadok ak hodnota v bunke C nad nim bude prázdna teda false, ako náhle tam vpíšem číslo chcem aby sa mi odkryl další riadok. A toto sa opakovalo od riadku 4 po 104 napríklad. takze vzdy ked do riadku napisem cislo zobrazi sa dalsi riadok... Zatial mi to ide cez tento prikaz: If Range("C32").Value = 0 Then Rows("33").EntireRow.Hidden = True Else Rows("33").EntireRow.Hidden = False End If Avsak chcel by som tennto skript napisat nejako uhladenejsie, neviete mi poradit? Dakujem

PavelR

Přidáno: 08.04.16 12:30

Dobrý den, s makrama začínám a nevím si rady. Mám tabulku, kde potřebuji vymazat hodnoty od B4 po poslední plnou buňku v tomto sloupci a od C4 po poslední plnou buňku vložit obsah buňky C2. Předem moc děkuji za pomoc

Voyager

Přidáno: 31.05.16 07:06

Dobry, den. Diky moc za skvele prispevky. Zacinam s VBA/makro v excelu a moc prosim o radu jak UDELAT BLOK V SLOUPCICH A az D - OD POSLEDNIHO RADKU(zaznamu) SMEREM NAHORU O PRESNE 16918 RADKU. Vzdy se mi jedna o sloupce A,B,C a D a vzdy jde o prave 16918 radku od posledniho radku nahoru, ale posledni radek kazdym dnem o tech 16918 radku narusta. Automakro mi vygenerovalo toto (vypsana jen problemova cast): ActiveCell.SpecialCells(xlLastCell).Select Range("A259597:D276514").Select Range("D276514").Activate Selection.Copy Vsimnete si, ze mi vytvoril a zkopiroval blok s pevnymi bunky (podle prvni ukladane predlohy), ale ja mu potrebuju rict tuto hlasku: 1. najdi posledni radek s hodnotama 2. udelej blok pro sloupce A,B,C,D od tohoto posledniho radku smerem nahoru o 16918 radku 3. zkopiruj tento blok Pomuze mi nekdo, prosim. Teprve zacinam. DEKUJI mockrat :)

Jojo

Přidáno: 02.06.16 13:25

To Voyager:rwLast = ActiveCell.SpecialCells(xlLastCell).Row Range("A" & rwLast - 16917 & ":D" & rwLast).Select Range("D" & rwLast).Activate Selection.Copy

Jojo

Přidáno: 02.06.16 13:56

To Voyager: -- (Poznámka) Riadok: -- Range("D" & rwLast).Activate -- nie je nutný

Josef Němec

Přidáno: 14.06.16 16:10

Dobrý den, chtěl bych se zeptat, zda existuje nějaká funkce, která by přečetla číslo z buňky a podle toho vytvořila příslušný počet sloupců. Jedná se o seznam na objednávání obědů, kdy se počet jídel v jednom dni pohybuje v rozmezí tří až pěti druhů. Děkuji za radu.

Jojo

Přidáno: 17.06.16 07:45

To Josef Němec: -- Nerozumiem zadaniu. Kde by to malo vytvoriť? Medzi určitými stĺpcami, alebo na konci s popisom hlavičky/čísla obedu? Ak je možné prosím o príklad, napr. medzi A a B vložiť 3 až 5 stĺpcov.

Luffi

Přidáno: 23.09.16 10:00

Dobrý den. Smekam nad tak sirokym rozsahem znalosti! Potreboval bych prosim poradit ci jiz formou maker nebo VBA ... Priklad: Na listu A mam tabulku s 2000 radky obsahlych data ve 30 sloupcich. Na listu B mam stejny pocet radku ale jenom vyber nekterch sloupcu (10) z listu A, ktere mam propojene na list C kde mam labely pro tisk. Data z B do C se me doplni po zadani cisla radku. Data na listu B zacinaji a konci na stejnem radku, jak jsou na listu A. Na cislovani radku vyuzivam jenom listu excelu t.j. nemam cislovani zvlast ve sloupci. Otazka: Jak dynamicky osetrit tabulku B, kdyz bych odstranil cely radek v tabulce A, cim se vsechna data posunou o jeden radek. Tim padem se mne rozhodi data v tabulce B protoze tam radek ktery byl odstranen v A odstraanen a na labelech vznikne zmatek. Informace jiz nebudou sedet podle radku meyi A a B. Potrebuji data na B zachovat i po odstraneni radku v tabulce A anebo aby odstranilo dynamicky radek i v listu B. Dekuji moc krát.

Jojo

Přidáno: 27.09.16 15:11

To Luffi: -- odstránenie toho istého čísla riadku(-ov) na 2 rôznych listoch (zvyšné riadky sa posunú smerom hore)Sheets("Hárok1").Rows("10:10").Delete Shift:=xlUp Sheets("Hárok2").Rows("10:10").Delete Shift:=xlUp

Tovog

Přidáno: 07.11.16 20:32

Řesím stejný problém, co Pekox. Nebyla by rada? Zadávání oblasti buněk parametricky.

Venca

Přidáno: 15.12.16 01:12

Dobrý den, potřeboval bych poradit. Mám tabulku věcí, která má více jak 4.000 řádků. Pokud nějakou věc odepíši (je vyřazena z majetku), tak mi zmizí ze sloupce majetek (tzn., že se majetek zmenší) a vyskočí ve sloupci odpisů (hodnota odpisů se zvětší) a já bych potřeboval, aby se mi odpisy objevily v nové tabulce, tzn. aby mi automaticky při vyřazení se vytvořila nová tabulka, kde by byly pod sebou všechny vyřazené věci, v tom pořadí v jakém se odepíší čí v pořadí jak jdou v původní tabulce za sebou, tzn., že bych nemusel listovat ve čtyřtisícové tabulce, ale měl bych tabulku třeba o deseti řádcích, kde bych viděl původní řádky, ovšem pouze ty, které byly vyřazeny… Děkuji za pomoc, s pozdravem Venca







Sdílejte

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

Nové články


Newsletter

Přihlaste se odběru novinek a získejte:
Ebook zdarma -
10 kroků ke zvládnutí (Word, Excel, PowerPoint)
Šipka Kniha 3D Více o ebooku ...

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 - 2017 | 120581

Tento web zatím neprošel jazykovou korekturou. Beta verze redakčního systému.