VBA Tools

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")  'worksheet to kill rows (not include Arkusz2)
Dim wks2 As Worksheet: Set wks2 = Sheets("Arkusz2")  'worksheet with elements to stay
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

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.