comparare 2 coloane date

Am in sheet1 in range-ul (a1:a5) seriile: 1,2,3,4,5
Am in sheet2 in range-ul(a1:a8) seriile: 1,22,3,15,16,4,10,2.

Intrebarea este urmatoarea.

Fiecare numar in parte din sheet1 trebuie sa existe in sheet2 (nu conteaza daca exista o singura data sau de mai multe ori). In cazul in care vreun numar din sheet1 nu are pereche corespondenta in sheet2, intregul rand din sheet1 va fi sters.

Ma puteti ajuta sa fac acest lucru in VBA la apasarea unui buton?

Pui codul de mai jos intr-un modul, faci butonul si asociezi macro-ul la butonul cu pricina.

Option Explicit

Sub StergeRanduri()
	Dim rg1, rg2 As Range
	Dim i As Long
	Set rg1 = ThisWorkbook.Worksheets("Sheet1").Range("A1:A5")
	Set rg2 = ThisWorkbook.Worksheets("Sheet2").Range("A1:A8")
	Application.ScreenUpdating = False
	For i = rg1.Cells(rg1.Rows.Count).Row To rg1.Cells(1).Row Step -1
		If rg2.Find(rg1.Cells(i).Value, lookat:=xlWhole) Is Nothing Then
			ThisWorkbook.Worksheets("Sheet1").Range(i & ":" & i).Select
			Selection.Delete Shift:=xlUp
		End If
	Next i
	ThisWorkbook.Worksheets("Sheet1").Range("A1").Select
	Application.ScreenUpdating = True
	Set rg1 = Nothing: Set rg2 = Nothing
End Sub

Trick-ul unei rutine in care intr-un ciclu vrei sa stergi un rand in functie de o anumita conditie e sa faci acel ciclu (bazat pe numarul randului) in ordine inversa, adica de la coada la cap, pentru ca in felul asta nu mai denaturezi numarul randului pe care urmeaza sa-l verifici, cum se intampla daca faci ciclul in ordine crescatoare.

 gecs, on 6th August 2011, 09:23, said:

Ai dreptate, daca mergi de la cap la coada apar erori in momentul in care sunt doua randuri consecutive care trebuiesc sterse, al doilea rand ti-l sare deoarece primul rand fiind sters, al doilea rand devine primul.

Pentru a evita chestia asta eu faceam intai un clearcontents pe rand si de abia dupa aia veneam cu delete rows. Evident ca nu imi placea metoda deoarece la baze de date mari se pierdea mai mult timp. Cautam o rezolvare eleganta.
Multumesc mult. Le ai cu vb-ul

Codul de mai jos poate fi rulat din orice foaie a workbook-ului (fara buton, cu Alt+F8 -> selectat StergeRanduri -> Run) si afiseaza si in StatusBar un mesaj cu numarul randului ce a fost sters. Daca faci un test cu primele 1000 de celule din Sheet1, coloana A, o sa vezi ca in urma rularii ramai cu valorile din Sheet2, coloana A, numai ca ordonate crescator.

Option Explicit

Sub StergeRanduri()
	Dim rg1, rg2 As Range
	Dim i As Long
	Set rg1 = ThisWorkbook.Worksheets("Sheet1").Range("A1:A1000")
	Set rg2 = ThisWorkbook.Worksheets("Sheet2").Range("A1:A8")
	Application.ScreenUpdating = False
	For i = rg1.Cells(rg1.Rows.Count).Row To rg1.Cells(1).Row Step -1
		If rg2.Find(rg1.Cells(i).Value, lookat:=xlWhole) Is Nothing Then
			ThisWorkbook.Worksheets("Sheet1").Range(i & ":" & i).Delete Shift:=xlUp
			Application.StatusBar = "Sters randul " & i
		End If
	Next i
	Application.ScreenUpdating = True
	Application.StatusBar = False
	Set rg1 = Nothing: Set rg2 = Nothing
End Sub