Extra üres sorok a munkalap alján
2021-07-13T15:36:02+02:00
2021-07-17T17:57:57+02:00
2022-08-12T03:45:29+02:00
Zsolt68
Sziasztok!

Egy kb 13000 sort tartalmazó munkalapon futtattam az alábbi kódot:

Sub rad_del() 'A radiológiai duplikációt törli Dim i As Long, x As Long Dim taj_1 As String, taj_2 As String Dim adm_2_dat As Date, adm_1_dat As Date, rad_dat As Date Dim rov_1 As String, rov_2 As String, mh As String Sheets(3).Select x = Sheets(3).Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To x taj_1 = Cells(i, 3).Value taj_2 = Cells(i + 1, 3).Value If taj_1 = taj_2 Then adm_1_dat = Cells(i, 7).Value adm_2_dat = Cells(i + 1, 7).Value If adm_1_dat = adm_2_dat Then mh = Cells(i, "T").Value rov_1 = Left(mh, 2) mh = Cells(i + 1, "T").Value rov_2 = Left(mh, 2) If rov_1 = rov_2 Then Cells(i, 1).Select Rows(i + 1).Select Selection.Delete Shift:=xlUp x = x - 1 Else End If Else End If Else End If Next End Sub
Futás közben belecsúszott egy számomra végtelennek tetsző ciklusba, ami valójában az volt, hogy az x-et valamiért hirtelen 1 M fölé lőtte. Ctr+Shift+End gombokra most is az adatot valóban tartalmazó utolsó sorra lép. Évekkel ezelőtt már olvastam itt egy "láthatatlan sorokat törlő" megoldásról, de azt most sajnos nem találtam meg.
Köszönöm, ha válaszoltok!
Zsolt
Mutasd a teljes hozzászólást!
elméletileg a 

ss = worksheets(ws_neve).cells(1,1).currentregion.rows.count
megszámolja a a1 cellától az egybefüggő sorok számát. 
ha az  1M akkor annak oka van, van ott adat, tehát az is kell vizsgálni. 

ha nem egybefüggő a terület akkor 

ss = worksheets(ws_neve).usedrange.rows.count
szintén megszámolja. 

ha nagy a táblázatod, akkor nyald be memóriába, és pikk pakk dolgozik vele

pl

ssdata = worksheets(ws_neve).cells(1,1).currentregion.rows
vagy

ssdata = worksheets(ws_neve).usedrange.rows for i = ss to 1 step -1 if (ssdata(i, 3) = ssdata(i - 1, 3) then if (ssdata(i, 7) = ssdata(i - 1, 7) then trallalla....

szerintem gyorsan lefut....
Mutasd a teljes hozzászólást!

  • Szia, 

    ugyan nem értelmeztem a kódot, de én a helyedben a végéről indulnék, és akkor nem kell az x-et változtatni, és akkor nem fog sehová elmászni,. 
    tehát
    for i=x to 2 step -1

    aztán:
    én a helyedben a selecteket eldobnám,  mert lassítja a rendszert. 
    tehát ez helyett: 

    Cells(i, 1).Select Rows(i + 1).Select Selection.Delete Shift:=xlUp
    A

    worksheets(ws_neve).Rows(i + 1).Delete Shift:=xlUp
    ot alkalmaznám. 



    Cells(i, 1).Select
    -et nem is értem, hogy minek. 

    még egy dolog: 
    ha az else ágat nem használod akkor nem is kell létrehozni. 
    egy határig minél tömörebb a kód annál áttekinthetőbb, és ezért könnyebb a hibát is megtalálni, ha szükséges... 

    de a for ciklus a a fontos, a többi csak beledumálás.... 
    azzal meg is oldódik szerintem a problémád.
    Mutasd a teljes hozzászólást!
  • Szia!
    Lehet, hogy erre gondoltál:

    X = ActiveSheet.UsedRange.Address
    viszont hogy ne legyen gond, a hibakezelést is bele kellene iktatni, valahogy így a rutinod végén:

    On Error Resume Next X = ActiveSheet.UsedRange.Address On Error GoTo 0
    Visszaállítja az utolsó cellára ugrás címét.
    Akkor viszont ha pl. szemét gyűlik össze más oszlopban is, de neked csak az A oszlop szerint lenne jó beállítani az utolsó sor címét, akkor az A oszlop utolsó cellája után törölni kell a tartalmat, mert a fenti kód nem fog működni.
    Tehát pl. az A oszlop utolsó használt cellája után a terület többi részén törölheted a tartalmat így:

    Range(Cells((Cells(Rows.Count, "A").End(xlUp).Row) + 1, "A"), Cells(ActiveCell.SpecialCells(xlLastCell).Row + 1, ActiveCell.SpecialCells(xlLastCell).Column)).Delete
    majd jöhet a X = ActiveSheet.UsedRange.Address
    Mutasd a teljes hozzászólást!
  • Szia!

    Van egy számláló ciklusod ami :

    For i = 2 To x

    A cikluson belül van egy sor ami  speciális esetekben lefut, (ha egyeznek taj számok és más részek)

    Ezen belül van egy problémás sor:

    x = x - 1

    Tegyük fel hogy  3 sor van a táblázatban
    X=3

    Elindul a cilkus i=2  
    A második és harmadi sor egyzik...

    Törlöd a harmadik sort...
    X = 3-1= 2

    A követkető for ciklusban i=i+1 = 2+1 = 3

    Ezzel a lépéssel úgy vágod hátba a For ciklust hogy az nem találja meg a saját végét...
    Nem fogja észrevenni hogy időközben az X lecsökkent és neki nem kellene egy újabb ciklusba esnie.


    Vedd ki ezt az egy sort (x = x-1) és a rutin max a végén pár üres sort is átnéz a munkalap végén, de nem fog végtelen ciklusba futni.
    Ha a 13000 sorból van 100-200 duplikált akkor sem fog 1-2 másodperccel tovább tartani.

    Vagy az x csökkentée után tégyél be egy ifet amiben megnézed hogy i >= x ha ez igaz akkor exit for.
    Mutasd a teljes hozzászólást!
  • Szia!
    Az
    X = ActiveSheet.UsedRange.Address
    után Error 13 - Type mismatch hibával leáll.
    Mutasd a teljes hozzászólást!
  • Szia!

    Teljesen jogos a meglátás, erre nem gondoltam. (Kb. 16e és 52e közötti sorokkal dolgozom.)
    Viszont továbbra is kérdés, hogyan törlöm az utolsó üres temérdek sort?

    Üdv!
    Mutasd a teljes hozzászólást!
  • Szia!

    Nem tudok a végéről indulni, mert akkor is 1M feletti sorról kezdene.

    A selectre vonatkozó javaslatot köszönöm! Eredetileg azért volt benne, hogy F8-al futtatva az elején lássam, hogy jó sorokat jelöl-e ki és töröl.

    Üdv!
    Mutasd a teljes hozzászólást!
  • Igazán nem bántani akarlak, de ha végigolvasod amit írtam, akkor az általad írt hiba fel sem jön.
    Azt hiszem a kérdés nem a kódod optimalizálására irányult, hanem "láthatatlan sorokat törlő" megoldásra. Az pedig pont azt csinálja.
    Mutasd a teljes hozzászólást!
  • elméletileg a 

    ss = worksheets(ws_neve).cells(1,1).currentregion.rows.count
    megszámolja a a1 cellától az egybefüggő sorok számát. 
    ha az  1M akkor annak oka van, van ott adat, tehát az is kell vizsgálni. 

    ha nem egybefüggő a terület akkor 

    ss = worksheets(ws_neve).usedrange.rows.count
    szintén megszámolja. 

    ha nagy a táblázatod, akkor nyald be memóriába, és pikk pakk dolgozik vele

    pl

    ssdata = worksheets(ws_neve).cells(1,1).currentregion.rows
    vagy

    ssdata = worksheets(ws_neve).usedrange.rows for i = ss to 1 step -1 if (ssdata(i, 3) = ssdata(i - 1, 3) then if (ssdata(i, 7) = ssdata(i - 1, 7) then trallalla....

    szerintem gyorsan lefut....
    Mutasd a teljes hozzászólást!
  • Szia!

    az x meghatározásánál a rows.count helyett írj be konkrét számot. A régi excelek 65535 sort kezelnek, az újak 1048576-ot.

    x = Sheets(3).Cells(1048576, 1).End(xlUp).Row
    Valamint ha sorokat törölsz menet közben, akkor inkább Do While cells(Sor,"A")<>"" ciklust alkalmaznám, feltéve, hogy biztos nincs közte üres sor. Ha van, akkor a For ciklus marad, a végén az üres sorok átnézésével.
    Mutasd a teljes hozzászólást!
  • Szia!
    Igazán nem veszem bántásnak és hálás vagyok minden segítségért. Viszont orvosként abszolút autodidakta módon próbálom a javaslatokat alkalmazni, és néha szájbarágós módra van szükségem. :)
    Szóval beírtam:

    Sub rad_del() 'A radiológiai duplikációt törli Dim i As Long, x As Long Dim taj_1 As String, taj_2 As String Dim adm_2_dat As Date, adm_1_dat As Date, rad_dat As Date Dim rov_1 As String, rov_2 As String, mh As String Sheets(3).Select Range(Cells((Cells(Rows.Count, "A").End(xlUp).Row) + 1, "A"), Cells(ActiveCell.SpecialCells(xlLastCell).Row + 1, ActiveCell.SpecialCells(xlLastCell).Column)).Delete x = Sheets(3).Cells(Rows.Count, 1).End(xlUp).Row x = ActiveSheet.UsedRange.Address For i = 2 To x taj_1 = Cells(i, 3).Value taj_2 = Cells(i + 1, 3).Value If taj_1 = taj_2 Then adm_1_dat = Cells(i, 7).Value adm_2_dat = Cells(i + 1, 7).Value If adm_1_dat = adm_2_dat Then mh = Cells(i, "T").Value rov_1 = Left(mh, 2) mh = Cells(i + 1, "T").Value rov_2 = Left(mh, 2) If rov_1 = rov_2 Then Cells(i, 1).Select Rows(i + 1).Select Selection.Delete Shift:=xlUp x = x - 1 Else End If Else End If Else End If Next On Error Resume Next x = ActiveSheet.UsedRange.Address On Error GoTo 0 End Sub
    Erre 1004-es kóddal leállt, arra hivatkozva, hogy nem végezhető el, mert a munkalap egyik táblázatába helyezne el cellákat. Hol / mit írok rosszul?
    Mutasd a teljes hozzászólást!
  • Az ss-re 11126-os értéket ad, ami valós. Ezzel egyidőben az x-re továbbra is 1046812-t. :(
    Mutasd a teljes hozzászólást!
  • Szia!

    az eredeti kódod módosítsd a lenti szerint...

    Tudom kicsit gányolás de most csak gyorsan h működjön...

    If rov_1 = rov_2 Then Cells(i, 1).Select Rows(i + 1).Select Selection.Delete Shift:=xlUp x = x - 1 if i>= x then exit for endif Else End If
    Mutasd a teljes hozzászólást!
  • Üres sort törölni:

    Megnézed hogy a sor üres... ha igen akkor törlöd...

    De ha az üres sorok a táblázat alján vannak az miért gond?
    Azok az üres sorok már benne voltak a táblázatban?
    Vagy csak arra gondolsz hogy tovább tudsz görgetni és akárháby üres sor van az alján?
    Az mindig is ott marad...
    Mutasd a teljes hozzászólást!
  • Szia!

    Már leírtam mi az oka....

    Végtelen for ciklus alakul ki ha menet közben az X-et csökkented törlés esetén 1-el.
    Ha az utolsó sorok törlődnek, akkor nem fog a for ciklus leállni sosem.
    Olvasd el amit korábban írtam, teszteld le lépésenkét egy sima 3 soros táblázattal, amiben egyormák a sorok.
    Láss csodát nem fog a futás befejeződni a 3 sor után...

    A javítás két módját is leírtam...
    A legegyszerűbb hogy kiveszed az x=x-1 sort.

    Tedd ezt és próbád ki hogyan működik ez esetben a rutin.
    Mutasd a teljes hozzászólást!
  • Privát üzi ment!
    Mutasd a teljes hozzászólást!
  • Sziasztok!

    Nagyon szépen köszönöm MINDENKI (floppy2, MSNEO, István Kövics, Pados) válaszát, segítségét! Azért floppy2-t jelöltem hasznosnak, mert ezt tudtam legjobban értelmezni, használni, sz.e. alkalmazni. (Természetesen ez az én ismereteimet minősíti, nem a tieteket. ) MSNEO, hamarosan küldök privit!

    Jó hétvégét!
    Mutasd a teljes hozzászólást!
abcd