VBATools

Usunięcie pozycji tabeli, nie zawartych na liście do pozostawienia

by 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

XL_Usuniecie_danych_z_poza_listy

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.

:, , , ,

Leave a Reply

Recently Active Members

Profile picture of vbatools
Profile picture of Karol Stilger
Profile picture of Joanna Subik
Profile picture of Anorak
Profile picture of marcinmachalowski
Profile picture of programistaaccess
Profile picture of piotrpawlik
Profile picture of Emil Wasilewski
Profile picture of kicekpicek
Profile picture of coldfusion
Profile picture of Gosia Borzęcka
Profile picture of lukaszch
Profile picture of itadministracja
Profile picture of farbenia
Profile picture of Łukasz Kałużny
Profile picture of kabzinski
Profile picture of rtynski
Profile picture of leszekbetlinski
Profile picture of Iv
Profile picture of Justyna Spychała