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