Istnieje wiele sposobów na kasowanie wierszy z tabeli. Sprowadzają się one do ich faktycznej likwidacji lub przeniesienia niepustych/wybranych wierszy w inne miejsce. Warto zaznaczyć, że niektóre metody nie sprawdzą się, jeżeli korzystamy z obiektu Tabela.
Wykrywanie filtra
Niedawno napisałem o wykrywaniu filtra w arkuszu. Wspomniałem tam, że standardowe metody AutoFilterMode i FilterMode nie zadziałają jeżeli użyjemy obiektu Tabela. Sprawdzą się natomiast, jeżeli dane są zorganizowane w zwykły sposób.
Aby sprawdzić czy na tabelę założony jest filtr, musimy wcześniej ustalić, czy znajduje się tam obiekt Tabela. Jeżeli tak, to należy odwołać się do jego właściwości AutoFilter.
Kilka dni temu zauważyłem jeszcze jedną ciekawą rzecz.
Problem z tabelą
Dla obiektu Tabela nie działa standardowy sposób kasowania wierszy. Mam tu na myśli pętlę od ostatniego wiersza do pierwszego wiersza z danymi.
INFORMACJA
Bardzo popularnym sposobem jest kasowanie wierszy w pętli zaczynając od końca. Nie jest to jednak rozwiązanie optymalne, ponieważ wykonujemy tą samą czynność wiele razy. Dużo lepiej jest wyznaczyć najpierw wiersze do likwidacji, a następnie – usunąć je wszystkie jednym poleceniem.
Aby skasować wiersze w obiekcie Tabela należy odwołać się – nie do konkretnego wiersza w arkuszu, lecz do konkretnego wiersza w Tabeli.
Kod makra
Poniższe makro kasuje wszystkie wiersze z wpisem „x” w kolumnie E.
|
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 |
Private Const msMODUL As String = "Module1" Option Explicit Public Sub UsunSkladnikiZOznaczeniemX() '// Makro kasuje z tabeli zbiorczej składniki z oznaczeniem "x" Const sPROC As String = "UsunSkladnikiZOznaczeniemX" Dim lTabWiersze As Long ' Liczba wierszy w "wksTabela" Dim r As Long ' Licznik pętli 'Aktywuj obsługę błędów na starcie 1 On Error GoTo ObslugaBledu 'Sprawdź ile mamy wierszy 2 lTabWiersze = lOstatni(wksTabela.Range("A:A")) 'Pętla po wszystkich wierszach tabeli 3 For r = lTabWiersze To 2 Step -1 4 If LCase(wksTabela.Cells(r, "E")) = "x" Then 5 wksTabela.ListObjects("MojaTabela").ListRows(r - 1).Delete 6 End If 7 Next r Wyjscie: 8 On Error GoTo 0 9 Exit Sub ObslugaBledu: 10 MsgBox "Wystąpił błąd nr " & Err.Number & " (" & Err.Description & ")." _ & vbCr & vbCr & "Linia kodu nr " & Erl & " w procedurze """ & _ sPROC & """ modułu """ & msMODUL & """.", vbInformation, "BŁĄD!" 11 Resume Wyjscie |
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 |
Public Function lOstatni(ByRef rngKolumna As Range) As Long ' Funkcja zwraca numer ostatniego niepustego wiersza w zakresie jednokolumnowym. Dim lTekst As Long Dim lLiczba As Long Dim lPrawda As Long Dim lFalsz As Long 'Sprawdź pozycję ostatniego tekstu i ostatniej liczby 1 On Error Resume Next 2 lTekst = WorksheetFunction.Match("żżż", rngKolumna, 1) 3 lLiczba = WorksheetFunction.Match(9.99999999999999E+307, rngKolumna, 1) 4 lPrawda = WorksheetFunction.Match(True, rngKolumna, 1) 5 lFalsz = WorksheetFunction.Match(False, rngKolumna, 1) 6 On Error GoTo 0 'Ostatni wiersz jest w tym przypadku wartością największą 7 lOstatni = WorksheetFunction.Max(lTekst, lLiczba, lPrawda, lFalsz) End Function |
