A lenti kód a sorok rugalmas törlését teszi lehetővé. Mitől rugalmas? Nos, attól, hogy kijelölhetünk cellákat/tartományokat/egész sorokat illetve ezek kombinációit (nem összefüggőeket is a CTRL használatával) és az azokat tartalmazó sorok egy lépésben törlődnek.
Adott az alábbi egyszerű tartomány:
Tegyük fel, hogy az alábbi sorokat akarjuk törölni: 8-10, 22 és 25. Ez makróval így néz ki:
A makróba hibakezelését is beépítettem (ha pl. az adatbevitel ablakot bezárjuk mielőtt kijelöltük volna a törlendő sorokat). Látható továbbá, hogy meglehetősen “bulletproof”, hiszen kiválaszthatunk cellákat/tartományokat/egész sorokat illetve ezek kombinációit. Amelyik jobban kézre áll, illetve kényelmesebb. A kódot hozzáadhatjuk a gyorselérési eszköztárhoz (QAT-hez) is (ennek mikéntje itt található).
Az adott munkafüzetbe szúrjunk be egy modult a Visual Basic szerkesztőjében és az alábbi kódot adjuk hozzá:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 |
Sub SorokRugalmasTorlese() Dim Tart As Range, i As Long, j As Long, D As Object, X, Cella As Range, Csere, TartUnio As Range 'Készítette: XLMotyo (https://xlmotyo.hu) 'a kód a sorok rugalmas törlését teszi lehetõvé. Mitõl rugalmas? Attól, hogy 'kijelölhetünk cellákat/tartományokat/egész sorokat illetve ezek kombinációit '(nem összefüggõeket is a CTRL használatával) és az azokat tartalmazó sorok egy lépésben törlõdnek Set D = CreateObject("scripting.dictionary") 'cellák/tartományok/sorok kijelölése a felhasználó által: On Error GoTo Vege Set Tart = Application.InputBox("Jelöld ki a cellákat/tartományokat/sorokat ahol a sorokat törölni akarod!", , , , , , , 8) On Error GoTo 0 Application.ScreenUpdating = False 'a kijelölést tartalmazó sorok eltárolása a D nevû Dictionary objektumban For Each Cella In Tart.Rows D(Cella.Row) = "" Next Cella X = D.keys '"TartUnio"-ban eltároljuk a törölni kívánt tartományokat For i = 0 To D.Count - 1 If TartUnio Is Nothing Then Set TartUnio = Cells(X(i), 1) Else Set TartUnio = Union(TartUnio, Cells(X(i), 1)) 'Union: sorok összesített területe End If Next i 'kijelölt sorok törlése: If Not TartUnio Is Nothing Then TartUnio.EntireRow.Delete xlShiftUp Application.ScreenUpdating = True Vege: End Sub |
A fenti kód kulcsa a Dictionary objektum (részletesebben lásd a kapcsolódó bejegyzésemet itt) valamint a
“Union”:
- olyan eljárás (method), mely két vagy több tartomány összességét adja vissza
- tartomány (range) típusú objektum
- teljes neve: “Application.Union” de Excel-ben elegendő az “Union” használata
- példa:
1 |
Union(Range("A5:A10"), Range("C2")).Select |
Ez a kód egyszerre jelöli ki az A5:A10-es tartományt és a C2-es tartományt:
Makró továbbfejlesztési ötletek:
– a fenti metódus alapján oszlopok törlése
– egész sor helyett kitörölhetünk egy sort pl. a 2-től a 12-es oszlopig
Remélem hasznos volt a poszt.
Kérdésed, észrevételed van? Szólj hozzá lent vagy dobj egy emailt: xlmotyo@gmail.com