VBA - mazaní řádků na základě vyhledání klíčového slova Vyřešeno

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

Moderátor: Mods_senior

Marena.net
nováček
Příspěvky: 21
Registrován: leden 09
Pohlaví: Muž
Stav:
Offline

VBA - mazaní řádků na základě vyhledání klíčového slova  Vyřešeno

Příspěvekod Marena.net » 22 led 2015 19:15

Zdravím,

chtěl bych někoho poprosit, jestli někdo nemá někde schovaný kód do VBA pro Excel, který umí následující:

Je-li v řádku kdekoliv k nalezení klíčové slovo (dejme třeba "auto"), smaž celý řádek
Takhle procházej celý sheet a smaž všechny řádky, ve kterém se toto klíčové slovo nachází
Je důležité, že to nesmí být stylem "hodnota buňky = "auto" - smaž řádek", ale představte si to cca tak, že byste označili řádek, CTRL+F, pokud bylo "auto" nalezeno, tak smaž řádek - a takhle procházet řádek po řádku

Podobné tématko už tu bylo, ale tam se jednalo o něco trochu jiného... :dontgetit:

Děkuji!

--- Doplnění předchozího příspěvku (22 Led 2015 20:12) ---

tak jsem našel toto:

Kód: Vybrat vše

Dim rng As Range, cell As Range, del As Range
Set rng = Intersect(Range("A:BQ"), ActiveSheet.UsedRange)
For Each cell In rng
If cell.Value Like "auto" _
Then
If del Is Nothing Then
Set del = cell
Else: Set del = Union(del, cell)
End If
End If
Next cell
On Error Resume Next
del.EntireRow.Delete

Pro mě to funguje skvěle, ovšem bych potřeboval, aby to fungovalo i když je v buňce něco jiného, než auto. Zkoušel jsem tam dát "*auto*", ale to nefunguje. Nějaké sugesce prosím?

--- Doplnění předchozího příspěvku (22 Led 2015 20:52) ---

zkusil jsem to udělat touto metodou:
Všechny buňky s klíčovým slovem jsem vyhledal a nahradil právě tím klíčovým slovem a to takto:

Kód: Vybrat vše

Cells.Select
    Selection.Replace What:="*bearer*", Replacement:="bearer", LookAt:=xlPart _
        , SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False


Bohužel, z nějakého důvodu pak přestane fungovat kód viz výše.

--- Doplnění předchozího příspěvku (22 Led 2015 22:31) ---

Poradil jsem si nakonec sam, tady je vysledek:

Kód: Vybrat vše

'Smazani beareru
Cells.Select
    Selection.Replace What:="*bearer*", Replacement:="bearer", LookAt:=xlPart _
        , SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

Dim pomocnaBearer As Range
   Dim SrchRng

   Set SrchRng = ActiveSheet.UsedRange
   Do
       Set pomocnaBearer = SrchRng.Find("bearer", LookIn:=xlValues)
       If Not pomocnaBearer Is Nothing Then pomocnaBearer.EntireRow.Delete
   Loop While Not pomocnaBearer Is Nothing

Mnoho lidi by reklo ze to neni elegantni reseni ale funguje spolehlive a rychle. V urcitem smyslu take setri spotrebu vykonu.

Reklama
  • 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
    1913
    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
    1544
    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
    908
    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 4 hosti