VBA Excel - smazání řádků

[MiraXP]

Zdravím odborníky !
Sice jsem tady studoval stará témata a starší příspěvky, ale zaboha jsem to nedal dohromady, aby to bylo funkční. Potřebuju makro, jenž prohledá list a smaže celé řádky, které ve sloupci A neobsahují řetězec nebo znaky např. "ABC" anebo ve sloupci B neobsahují znaky např. "DEF". Data nelze setřídit.
Jsem z toho už lama jelenovitá ....
Děkuji všem za případné tipy.

[Reklama]

[cmuch]

Ahoj,
Vyzkoušej na kopii dat toto.

Kód: Vybrat vše

Sub SmazUdaje()
Dim radek, radky As Long

radky = Cells(Rows.Count, 1).End(xlUp).Row 'zjisteni poctu radku ze sloupce A

Application.ScreenUpdating = False

    'nastavime od jakeho po jaky radek
    For radek = 1 To radky
        ' kontrola sloupcu A a B
       If Cells(radek, "A").Value <> "ABC" Or Cells(radek, "B").Value <> "DEF" Then
           'smazani udaju
          Rows(radek).Delete Shift:=xlUp
       End If
    Next
    Range("A1").Select
   
Application.ScreenUpdating = True

    MsgBox "Údaje promazány.", vbInformation
End Sub

[MiraXP]

Ano, takhle nějak jsem to měl také .... ale já potřebuju vymazat vše ostatní a právě řádky, které obsahují buňky ABC a DEF ponechat !

[cmuch]

Tak tady je oprava

Kód: Vybrat vše

...

Edit 11.4.1:57
kod odstraněn - nahrazen následujícím

[MiraXP]

Mno, ano, takhle se to bezvadně zacyklí a neudělá nic ....

[cmuch]

To nevím mě to jde dobře v sešitě co jsem si udělal.
Tak pošli sešit pokud to jde.

[MiraXP]

Tak tady to je ....

[cmuch]

Tak teď by už mohlo , já si nevšim, že to může být i část textu.

Kód: Vybrat vše

Sub SmazUdaje()
Dim radek, radky As Long

radky = Cells(Rows.Count, 1).End(xlUp).Row 'zjisteni poctu radku ze sloupce A

Application.ScreenUpdating = False

    'nastavime od jakeho po jaky radek
    For radek = radky To 1 Step -1
       
    Set Found1 = Range("A" & radek).Find(What:="abc")
    Set Found2 = Range("B" & radek).Find(What:="def")

       If Not Found1 Is Nothing Then GoTo dalsi
         If Not Found2 Is Nothing Then GoTo dalsi
            'smazani udaju
            Rows(radek).Delete Shift:=xlUp
dalsi:
    Next
   
Application.ScreenUpdating = True

Range("A1").Select
MsgBox "Údaje promazány.", vbInformation

Set Found1 = Nothing
Set Found2 = Nothing
End Sub

[MiraXP]

No jo, sakra, ono to fakt funguje !
Chlape, jsi hlava, děkuju za návod !