Całkiem niedawno napisałem na temat wykrywania autofiltra w konkretnym arkuszu. Napisałem tam m.in. że standardowe metody AutoFilterMode i FilterMode nie wykryją filtra w sytuacji, gdy mamy do czynienia z obiektem Tabeli. Sprawdzą się natomiast, jeśli dane są zorganizowane w zwykły sposób.
Wykrywanie Filtra
Aby wykryć czy w arkuszu jest założony autofiltr, należy sprawdzić, 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.
Dla obiektu Tabeli nie działa standardowy sposób kasowania wierszy (tzn. pętla od ostatniego do pierwszego wiersza).
Aby skasować wiersze w Tabeli należy odwołać się nie do konkretnego wiersza w arkuszu, lecz do konkretnego wiersza w Tabeli. Poniższe makro rozwiązuje ten problem.
Kod Makra
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
End Sub
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
