Makro na smazani radku se znakem - nefunguje Vyřešeno

[jiri255]

Dobrý den,

prosím o radu ohledně tvorby makra. Mám excel a ten obsahuje data pouze v jednom sloupci "A" a má asi 5000 řádků
s toho cca 800 řádků je prázdných, takže je za použití makra viz níže odstraním, ale objevil jsem problém.
Po skončení tohoto makra se nesmaže všech cca 800 prázdných řádků, ale jen zhruba polovina . Hledal jsem závadu
a všiml jsem si že, když klepnu do těch řádků co se neodstranily, tak je tam na začátku každého řádku prázdný znak
mezera.
Zkoušel jsem různá makra co jsem našel na fórech, ale nic nefunguje správně.
Pokud totiž použiju makro, kde mám zapsáno odstraň řádky co obsahují mezeru, tak mi to smaže všechno, protože
ty řádky kde jsou data obsahují mezi textem i na začátku před textem také mezery
Nevíte prosím někdo jak napsat makro, které by říkalo, že pokud řádek na začátku obsahuje mezeru a jinak je
prázdný, tak aby ten řádek odstranil?

Kód: Vybrat vše

Sub SmazRadky()
For i = 1 To Cells(6000, 1).End(xlUp).Row
If i = Cells(6000, 1).End(xlUp).Row Then Exit Sub
Do Until Len(Cells(i, 1)) > 0
Rows(i).Delete
Loop
Next i
End Sub


Předem děkuji za případné rady

[Reklama]

[Mirdad69]

Dobrý den,
to bude nějaký speciální znak, zkuste si funkcí =Kód zjistit číslo tohoto znaku a podle toho si upravit makro.
Možná bych ten znak vykopíroval a provedl replace tohoto znaku opravdu prázdným znakem.

[cmuch]

Možná by pomohla fce VYČISTIT do vedlejšího sloupce a v tom pak provádět to makro.
A nebo dát místo 0 1 Len(Cells(i, 1)) > 1

[Branscombe]

Nezkoušel jsem to, jelikož jsem línej vytvářet si demo soubor, ale dal bych tam následující:

Kód: Vybrat vše

Sub SmazRadky()

Dim Oblast As Range, Cll As Range
Set Oblast = ActiveSheet.Range("A1:A6000")

For Each Cll In Oblast
If Cll.Value = vbNullString Or Cll.Value = " " Then
Cll.Rows.Delete
End If
Next

End Sub



[jiri255]

děkuji ten znak je "32" tedy mezera.... zkoušel jsem změnit i tu 0 za 1, ale po spuštění se to makro nějak zaseklo a pořádd jede do nekonečna musel sem ten excel zavřít přes správce úloh jinak to, ale vypadalo že to odstraňovalo i řádky s tím znakem mezera, ale nemůžu to potvrdit vždy se to nějak zacyklí.
Zkoušel jsem i ten kód od uživatele "Branscombe" ,ale to samé.... také to vypadá, že to maže i řádky s mezerou, ale zacyklí se to a nejde to zastavit

--- Doplnění předchozího příspěvku (21 Led 2013 20:48) ---

Omlouvám se uživateli "Branscombe" omylem sem přikopíroval ten kód jako další k tomu co se zacykluje.
Otestoval jsem to makro samostatně a vypadá to, že to funguje perfektně podle představ = testuji bohužel
na provizorním excelu....(zapomněl jsem si ho zkopírovat), ale zítra otestuju na tom skutečném a dám
ještě vědět.
Prozatím všem velice děkuji za pomoc.

[cmuch]

Ještě i takto

Kód: Vybrat vše

Sub SmazRadky()
  For i = Cells(6000, 1).End(xlUp).Row To 1 Step -1
    If Not Len(Cells(i, 1)) > 0 Or Cells(i, 1) = " " Then
        Rows(i).Delete
    End If
  Next i
End Sub

[jiri255]

odzkoušel jsem i ten a také vypadá, že je funkční... zítra ho také otestuji..... ještě jednou děkuji za pomoc

[jiri255]

tak jsem to otestoval na reálných datech a nechápu proč, ale kód od "Branscombe" nesmazal vše nechal tam 3 řádky s mezerou, ale kód od
"cmuch" smazal úplně vše přesně, tak jak jsem potřeboval .
Měl bych ještě jeden dotaz..... na konci toho seznamu je cca 6 řádků kde sou čísla ve formátu "##.###.###,##" a tyto řádky na kterých je
číslo v tomto formátu bych potřeboval také odstranit.
Zkusil jsem kód:

Kód: Vybrat vše

Sub test()
Set Obl = Rows(6000)
For i = 1 To Cells(6000, 2).End(xlUp).Row
If Cells(i, 2) = "##.###.###,##" Then
Set Obl = Union(Obl, Rows(i))
End If
Next i
Obl.Delete
End Sub


to, ale není správně, protože to není funkční nevíte, jak by se tohle dalo vyřešit?

[Mirdad69]

a nestačí tam přidat Cells(i,2).NumberFormat = "##.###.###,##" ?

[jiri255]

upravil jsem kód na:

Kód: Vybrat vše

Sub test()
Set Obl = Rows(6000)
For i = 1 To Cells(6000, 2).End(xlUp).Row
If Cells(i, 2).NumberFormat = "##.###.###,##" Then
Set Obl = Union(Obl, Rows(i))
End If
Next i
Obl.Delete
End Sub


proběhlo to, ale řádky kde jsou čísla v tomto formátu to neodstranilo, možná jestli není problém v tom,
že to číslo není v té buňce na začátku, ale před ním je cca 20 mezer (každý řádek to má jinak) a
pak je teprve to číslo pak 3 mezery a další číslo (v jedné buňce na jednom řádku)
a takhle je tam pod sebou cca 6 řádků

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

Spíš by to asi chtělo něco co by na řádku hledalo text/číslice v tomto formátu "##.###.###,##" a v případě shody to
řádek smazalo, protože jsem se díval, že buňka nemá formát "číslo" ,ale "obecný"

[cmuch]

Nejlepší by bylo sem ty řádky upnout.

[jiri255]

takhle vypadjí ty řádky viz příloha = řádek 1,2,3 tam musí zůstat a řádky 4,5,6,7,8,9 by to makro mělo odstranit,
těch řádků je 6000, ale pro názornost by toto mělo postačit.

Sešit1.xls

(18.5 KiB) Staženo 39 x