Potřebuji makro na mazání řádků Vyřešeno

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

Moderátor: Mods_senior

marek26
Level 1.5
Level 1.5
Příspěvky: 115
Registrován: duben 08
Pohlaví: Nespecifikováno
Stav:
Offline

Potřebuji makro na mazání řádků

Příspěvekod marek26 » 06 kvě 2009 11:10

dobry den

prosim o pomoc

Columns("C:C").Select
Selection.AutoFilter
ActiveSheet.Range("$C$1:$C$20000").AutoFilter Field:=1, Criteria1:= _
"#NEDOSTUPNÝ"

je makro pre filter kde vybere v stlpci "C" #NEDOSTUPNÝ lenze ako urobit syntax tak aby mi vymazal prave tieto riadky #NEDOSTUPNÝ a samozrejme ostatne nech nevymaze.(rucne to vypada asi tak ze dame do filtru #NEDOSTUPNÝ a oznacime vsetko a dame pravou mysou "ODSTRANIT RADEK"
Este 1 problem neviem ako urcit variabilny RANGE vzdy davam racej rezervu (C1:C20000) pricom by stacil rozsah napr.C1:C5252 (vzdy podla mnozstva radku)
(raz ma subor 3252 riadkov, raz 4585, 458, 985 ... atd)

vdaka za pomoc

// Název tématu upraven na něco konkrétnějšího
// mike007

Reklama
Uživatelský avatar
mike007
Master Level 7.5
Master Level 7.5
Příspěvky: 5860
Registrován: srpen 07
Bydliště: Pardubice
Pohlaví: Muž
Stav:
Offline
Kontakt:

Re: Makro xls. ....filter  Vyřešeno

Příspěvekod mike007 » 06 kvě 2009 11:19

Makro níže ti najde řádky s hodnotou #NEDOSTUPNÝ ve sloupci C a ty smaže.

sub smazat()
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, "C")
If Not IsError(.Value) Then
Select Case .Value
Case Is = "#NEDOSTUPNÝ": .EntireRow.Delete
End Select
End If
End With
Next Lrow
End With
ActiveWindow.View = ViewMode
With Application
.Calculation = CalcMode
End With
end sub
Nejlepší hra je Excel!
Pravidla fóra PC-helpJak označit téma za vyřešené
»»»»»»»»»»»»»»»»»»»»»»»
UPOZORNĚNÍ - můj Skype, Soukromé zprávy či email neslouží jako tech. podpora.
Dotazy pište do fóra. Od toho tu je.

marek26
Level 1.5
Level 1.5
Příspěvky: 115
Registrován: duben 08
Pohlaví: Nespecifikováno
Stav:
Offline

Re: Potřebuji makro na mazání řádků

Příspěvekod marek26 » 09 kvě 2009 21:28

diky ..trosku dlhe ale dobre..skusim to som vdacny (asi som dal nevhodny nadpis priste bude lepsi)

marek26
Level 1.5
Level 1.5
Příspěvky: 115
Registrován: duben 08
Pohlaví: Nespecifikováno
Stav:
Offline

Re: Potřebuji makro na mazání řádků

Příspěvekod marek26 » 19 bře 2010 10:49

Prosim ta, asi tam mam chybicku, teraz nepotrebujem smazat NEDOSTUPNY, ale v stlpci B ak bunka neobsahuje IČO, tak nech vymaze cele riadky (cize ostanu mi cele riadky take, ktore v stlpci B obsahuje "ičo") ale tento prikaz len prejde ale nic sa neudeje...
V prilohe je vzorovy subor, cize ak prejde prikaz chcem tento subor mat ocisteny tym ze makro vymaze vsetky riadky ktore v stlpci B neobsahuje "ičo" Ak bude prikaz obsahovat aj to ze vymaze hned stlpec A aj stlpec C to je dobre tie su mi zbytocne, ide mi len oto aby zostali len ičá.

Kód: Vybrat vše

 Workbooks.Open Filename:="C:\Users\marek\Documents\konkurzy.xls"
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, "B")
If Not IsError(.Value) Then
Select Case .Value
Case Is <> "*IČO*": .EntireRow.Delete
End Select
End If
End With
Next Lrow
End With
ActiveWindow.View = ViewMode
With Application
.Calculation = CalcMode
End With
End Sub



Diky velice moc...
Přílohy
konkurzy.xls
(23 KiB) Staženo 21 x


  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • Mazání fotek na google fotky
    od Kincl6 » 05 srp 2024 19:45 » v Vše ostatní (sw)
    0
    4026
    od Kincl6 Zobrazit poslední příspěvek
    05 srp 2024 19:45
  • mpg x570 gaming edge wifi Potřebuji poradit jak na bot BIOSu Příloha(y)
    od ManemanTV » 15 pro 2024 21:31 » v Problémy s hardwarem
    11
    4237
    od ManemanTV Zobrazit poslední příspěvek
    16 pro 2024 18:18

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

Kdo je online

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