Mazaní řadku podle podmínky Vyřešeno

Programy pro práci v kanceláři (Word, Excel, Access…=>Office)

Moderátor: Mods_senior

Danyy
nováček
Příspěvky: 39
Registrován: září 09
Pohlaví: Muž
Stav:
Offline

Mazaní řadku podle podmínky

Příspěvekod Danyy » 30 zář 2009 01:54

Zdravim všechny

chtěl bych se zeptat jestli jde mazat řadky v excelu podle určité podmínky.

např. jeli buňka B5-B7 prázdna vymaže celý řádek.

díky za odpověd.

Reklama
navstevnik
Level 4
Level 4
Příspěvky: 1142
Registrován: srpen 08
Pohlaví: Nespecifikováno
Stav:
Offline

Re: Mazaní řadku podle podmínky

Příspěvekod navstevnik » 30 zář 2009 12:38

Vloz proceduru v editoru VBA do standardniho modulu:

Kód: Vybrat vše

Option Explicit

Sub OdstranRadek()
  Dim MyArea As Range, Podminka As Variant
  Dim Ofs As Long, Clmn As Range

  Set MyArea = ActiveSheet.UsedRange
  If IsEmpty(MyArea) Then End
  Application.ScreenUpdating = False
  '*********************
  ' odstrani radek, kde bunka v bloku bunek splnuje podminku
  '*********************
  On Error Resume Next
  Set Clmn = Application.InputBox("Zadej blok s prazdnymi bunkami, pr: D5:D10", Type:=8)
  If Err.Number <> 0 Then Exit Sub
  If Clmn.Columns.Count > 1 Then MsgBox "Lze zadat pouze 1 sloupec": Exit Sub
  Podminka = Application.InputBox("Zadej podminku, retezec, cislo" & vbCr _
  & "pro prazdnou bunku OK bez vlozeni hodnoty", Type:=1 + 2)
  If Podminka = False Then Exit Sub
  On Error GoTo 0
  Ofs = Clmn.Rows.Count - 1
  Set Clmn = Clmn.Resize(1, 1)
  Do ' odstraneni radku
    If Clmn.Offset(Ofs, 0).Value = Podminka Then Clmn.Offset(Ofs, 0).EntireRow.Delete
    Ofs = Ofs - 1
  Loop While Ofs > -1
  Range("a1").Select
  Application.ScreenUpdating = True
End Sub

Procedura odstrani na aktivnim listu radky, ve kterych je v zadanem jednosloupcovem bloku bunka obsahujici podminku (prazdna bunka, retezec, cislo), volat z nabidky nebo priradit klavesovou zkratku.

Danyy
nováček
Příspěvky: 39
Registrován: září 09
Pohlaví: Muž
Stav:
Offline

Re: Mazaní řadku podle podmínky  Vyřešeno

Příspěvekod Danyy » 30 zář 2009 23:21

To je geniální

díky


  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • Kopírování řádků s funkcí když Příloha(y)
    od Martyn20 » 20 črc 2023 16:50 » v Kancelářské balíky
    3
    2025
    od Melvidor Zobrazit poslední příspěvek
    21 črc 2023 08:41
  • Ukotvení prvního a posledního řádku v tabulce.
    od Kopusek » 13 pro 2023 10:50 » v Kancelářské balíky
    2
    1606
    od Kopusek Zobrazit poslední příspěvek
    14 pro 2023 08:55
  • excel text na konec více řádků najednou Příloha(y)
    od Myerina » 03 led 2024 11:51 » v Kancelářské balíky
    5
    1024
    od Zivan Zobrazit poslední příspěvek
    04 led 2024 09:42

Zpět na “Kancelářské balíky”

Kdo je online

Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 42 hostů