Excel-makro na promazání řádků

[spejle]

Dobrý den,
mám excel s mnoha řádky dat z experimentů a potřebovala bych nějaký předpis na to, aby mi v listu zůstal například každý desátý nebo každý druhý řádek a zbylé byly vymazány. Nevím si s tím rady, proto Vás moc prosím o pomoc. Předem děkuji, Iva.

[navstevnik]

Pouzij nize uvedenou proceduru (v editoru VBA - Alt+F11 - vloz do standardniho modulu, uprav nazev listu: Worksheets("nazev listu").., zavolej z nabidka Nastroje>Makro>...):

Kód: Vybrat vše

Option Explicit

' ponechat kazdy n-ty radek:
' Kazdy=(2;3;4;...,255) - ponecha pocinaje n-tym radkem nebo pocatkem kazdy m-ty radek
Sub OdstranRadky()
Dim MyArea As Range, PoslRadek As Long, Kazdy As Byte, Pocatek As Long
Dim Odstran As Range, Ofs As Long
  Set MyArea = Worksheets("list3").UsedRange
  If IsEmpty(MyArea) Then End
  PoslRadek = MyArea.Rows.Count
  Application.ScreenUpdating = False
'************************
  Pocatek = 0 ' nastavit
  Kazdy = 5 ' nastavit
'************************
  Set Odstran = Worksheets("list3").Range("1:" & Kazdy - 1).Rows
  If Pocatek = 0 Then
    Ofs = Kazdy
  Else
    Ofs = Pocatek
  End If
  Kazdy = Kazdy - 1
  Do While Ofs < PoslRadek
    Odstran.Offset(Ofs, 0).EntireRow.Delete
    Ofs = Ofs + 1
    PoslRadek = PoslRadek - Kazdy
  Loop
  If Pocatek = 0 Then Odstran.EntireRow.Delete
  Range("a1").Select
  Application.ScreenUpdating = True
End Sub

Testuj na kopii sesitu, jinak hrozi v pripade chyby ztrata dat!
vice k VBA zde: http://www.officir.ic.cz/excelentne.html

[Poki]

Zdravim,
otazka je, jestli tim 'zustal' myslite to, jestli se nepotrebne radky maji smazat nebo odstranit. Zkusim obe varianty.
Timto kodem muzete radky jen Smazat (kolikaty radek bude smazat zalezi na hodnote promenne Pocet):

Kód: Vybrat vše

Sub Smazat()
Dim Pocet As Integer
Pocet = 2
For i = 1 To Application.WorksheetFunction.CountA(Range("a:a")) Step Pocet
   Rows(i).ClearContents
Next
End Sub

Pokud chcete radky Odtranit, pouzijte tento kod (kolikaty radek bude smazat zalezi na hodnote promenne Pocet):

Kód: Vybrat vše

Sub Odstranit()
Dim Pocet As Integer
Pocet = 2
For i = Pocet To Application.WorksheetFunction.CountA(Range("a:a")) Step Pocet - 1
   Rows(i).Delete
Next
End Sub

[spejle]

Moc děkuji