Makro - odstranění řádku, který obsahuje určitý znak Vyřešeno

[bpsa]

Dobrý den,
potřebuji poradit s makrem, které mi odstraní řádek, který obsahuje určitý znak, hledání podle sloupce A
Ten znak může být obsažen i uprostřed text
např. -
tak odstraní řádky
7-
-
45-565

Našel jsem makro na jen specifický znak v buňce, viz. níže


Sub smazat_sedmicky()
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, "A") ' Sloupec s hledanými podmínkami
If Not IsError(.Value) Then
Select Case .Value
Case Is = "7": .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

[Reklama]

[Mirdad69]

Zdravím,
a co takto?

Kód: Vybrat vše

Sub smazat_sedmicky()

Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long
Dim Kde as integer

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, "A") ' Sloupec s hledanými podmínkami
If Not IsError(.Value) Then

On Error Resume Next
Kde = WorksheetFunction.Search("#", .Value, 1)
If Err.Number = 0 Then
 .EntireRow.Delete 'podmínka v uvozovkách
End If
Err.Clear


End If
End With
Next Lrow
End With
ActiveWindow.View = ViewMode
With Application
.Calculation = CalcMode
End With
End Sub


[bpsa]

Jo, diky :)
funguje