Excel - vložení prázdného řadku

Od: Datum: 12.08.13 12:31 odpovědí: 6 změna: 12.08.13 15:36

Mám tabulku v Excelu a potřebuji, asi pomocí makra, vložit prázdný řádek, každý 20. řádek až do konce tabulky. Tzn. na řádek 21, 41, 61, ... vložit prázdný řádek až do konce tabulky. Prostě rozdělit tabulku na bloky po 20 řádcích, oddělené prázdným řádkem. Poradíte jak? Dík.


Seznam odpovědí:
 
moment čekejte prosím, probíhá přenos dat...
Zobrazení struktury odpovědí v otázce
Skrytí struktury odpovědí v otázce
Zobrazení struktury odpovědí v otázce

 

Odpovědi na otázku:
Od: ron*
Datum: 12.08.13 12:44

Myší najedete na řádek následující budoucí vložený řádek (ve vašem případě na např. řádek 21). , kliknete na ikonu vložit a vyberete:" vložit řádek". Postup opakujte u dalších řádků.

Ohodnoceno: 0x
 
Od: mowla*
Datum: 12.08.13 12:46

Najet kurzorem na řádek, před nímž chceš mít ten prázdný a v menu - Vložit - Řádek... Jen pozor, ať ti prázdné řádky neudělají problémy při zpracování tabulky.

Kolik řádků ta tabulka má? :-D

Ohodnoceno: 0x
 
Datum: 12.08.13 12:59
avatar

Myslím, že tazateli jde o vložení hromadné, jednoduchým úkonem. Pokud bude vkládat řádky po jednom, do tabulky řekněme s 10 000 řádky, asi ho to brzo přestane bavit. *smich*

Ohodnoceno: 0x
 
Od: axus®
Datum: 12.08.13 13:06
avatar

Tohle by melo pomoci...

Sub test()
Dim r As Range
Set r = Range("A1")
Do
Range(r.Offset(20, 0), r.Offset(20, 0)).EntireRow.Insert
Set r = Cells(r.Row + 20, 1)
MsgBox r.Address
If r.Offset(1, 0) = "" Then Exit Do
Loop

End Sub

doplněno 12.08.13 16:22:

S tim MsgBoxem ma figurek samozrejme pravdu.

Byl tam pouze pro kontrolu, jestli to vklada spravne radky.

Staci ten radek umazat a cele to probehne automaticky.

doplněno 13.08.13 12:17:

Pokud mi to dava po 19 radkach misto 20, coz ma figurek asi pravdu a timto mu za opravu dekuji, tak staci pricist jednicku v tomto radku:

Set r = Cells(r.Row + 20+1, 1)

Zkratka 21 misto 20. Nic neresitelneho. Konec koncu by mohlo byt i nakonec lepsi udelat z tohoto parametr a krok (pocet radku) zadavaty nekde zvlast, pokud by mel byt napriklad nekdy jiny, nez zrovna 20.
*nevi*

Ohodnoceno: 3x
 
Od: intos
Datum: 12.08.13 14:39

Dekuji.

Datum: 12.08.13 15:36
avatar

tady máte dvě makra. Dobře se na ně podívejte, čím se vlastně liší. Jedno skončí na řádku 300 (Delkatabulky=300), číslo 300 si můžete upravit. Druhé jede až do konce tabulky (DelkaTabulky=Row.count). Ale radím vám, použijte raději to první makro, protože počet řádků je pře sto tisíc a projet celou tabulku shora až úplně dolů trvá celé věky.

Řádek Range("A1").Offset(krok * i + (i - 1), 0).Insert je sice trochu nepřehledný, ale není v něm nic složitějšího, než výpočet řádku, který se přidává. Při prvním průchodu cyklem se přidá řádek 21, při druhém 42, při třetím 63 atd.

Příkaz On Error Resume Next není nutný. Slouží jen k ignorování případné chyby v cyklu.

Tak mnoho zdaru :)

*

Sub VlozitRadek1()
On Error Resume Next
krok = 20
DelkaTabulky = 300
For i = 1 To DelkaTabulky
Range("A1").Offset(krok * i + (i - 1), 0).Insert
Next i
End Sub

*

Sub VlozitRadek2()
On Error Resume Next
krok = 20
DelkaTabulky = Rows.Count
For i = 0 To DelkaTabulky
Range("A1").Offset(krok * i + (i - 1), 0).Insert
Next i
End Sub

doplněno 12.08.13 16:16:

Doplněk po tom, co jsem si právě přečetl o kousek výš. Nikdy nepoužívejte mesidžbox uvnitř cyklu Do. Jak jsem napsal, řádků je přes 100 tisíc a jestli budete postupovat po kroku 20, pak uživatelům vašeho programu nezbude, než 5000x zmačknout tlačítko OK.

Asi vás budou honit po poli, protože není způsob jak zastavit rozjetý cyklus Do, jedině tvrdý reset.

Takže radím, téhle součástce se zdálky vyhněte.

MsgBox r.Address *bum*

doplněno 13.08.13 07:33:

Axusovo makro nahoře dává špatné výsledky. První oddělený blok má 20 řádků a každý další 19.

doplněno 13.08.13 12:48:

Axus.

Nic ve zlém, ale to vaše makro psal alchymista, který neví co dělá.

Když už, pak mělo vypadat tady tak :

Sub test()
Dim Krok As Byte
Dim r As Range
Krok = 20
Set r = Range("A1")
Do While r.Offset(1, 0).Value <> ""
r.Offset(Krok, 0).EntireRow.Insert
Set r = Cells(r.Row + Krok + 1, 1)
Loop
End Sub

Ohodnoceno: 1x
 

 

 

 

 

Přihlásit se k odběru odpovědí z této otázky:

Neneseme odpovědnost za správnost informací a za škodu vzniklou jejich využitím. Jednotlivé odpovědi vyjadřují názory jejich autorů a nemusí se shodovat s názorem provozovatele poradny Poradte.cz

 
Copyright © 2004-2016 Poradna Poradte.cz. Všechna práva na poradně Poradte.cz vyhrazena.