Usunięcie pozycji tabeli, nie zawartych na liście do pozostawienia
by vbatools on Jan.11, 2012, under Excel, Porady
Posiadamy dwie listy. Jedna to baza danych towarów naszej oferty. Wśród niej znajdują się akronimy produktów (niepowtarzalne nazwy) oraz reszta danych charakteryzujących dany przedmiot, oraz w drugim arkuszu, w kolumnie “A:A” listę akronimów, które muszą pozostać w ofercie. Wszystkie te towary, które nie znajdują się na tej liście z arkusza 1 muszą zostać usunięte.
Poniżej przedstawiam przykład, dzięki któremu będzie można szybko usunąć pozycje z oferty pozostawiając rekordy zgodnie z listą w arkuszu 2.
Option Explicit Sub Kill_not_in_Array() 'MVP OShon from VBATools.pl Dim wks1 As Worksheet: Set wks1 = Sheets("Arkusz1") 'arkusz z pozycjami do usunięcia (częściowo zawartych w Arkusz2) Dim wks2 As Worksheet: Set wks2 = Sheets("Arkusz2") 'arkusz z elementami do pozostawienia Dim tbl(), x&, y&, jest As Boolean, max_row&: max_row = wks1.Cells(Rows.Count, "a").End(xlUp).Row tbl = Application.Transpose(wks2.Range("a1:a" & wks2.Cells(Rows.Count, "a").End(xlUp).Row).Value) Application.ScreenUpdating = False With wks1 For x = max_row To 1 Step -1 jest = False For y = 1 To UBound(tbl) If tbl(y) = .Cells(x, "A") Then jest = True: Exit For Next y If jest = True Then .Rows(x).Delete Next x End With Application.ScreenUpdating = True End Sub
Rys.1 Przedstawienie działania kodu
Kilka wyjaśnień:
- Określamy arkusze w których jest baza danych oraz baza rekordów jakie chcemy pozostawić
- Przypisujemy do tablicy elementy do pozostawienia (arkusz2 kolumna A:A)
- Sprawdzamy w bazie danych czy rekord znajduje się w tablicy, jeśli tak, to nie sprawdzamy dalej
- Usuwamy rekord o ile sprawdzanie zostało potwierdzone, i przechodzimy do następnego w bazie danych.
(c) Shon Oskar – www.VBATools.pl
Wszelkie prawa zastrzeżone. Żadna część ani całość tego artykułu nie może być powielana ani publikowana bez zgody autora.