Karşılaştırma

[acar6783]

konuyla alakalı baya bır arastrma yaptım ama ya bulmadım ya da uygulayamadım benım sayfama
sorunum şu:
karşılaştırma adlı dosyam da üç sayfa var yoldakiler sayılanlar ve sonuç sayfaları,
istediğim yoldakiler sayfasındaki ve sayılanlar sayfasındakılerı karsılaştırıp ,
liste şeklinde hangı urun ne kadar eksık ya da fazlaysa ya da sayılmamıssa
sonuç sayfasına yazması eğer hata yoksa iki sayfadakı urunler adetlerı ısımlerı aynıysa hata yok adlı bır yazı cıkması
bunun için bir formul yada makro yazabılırmıyız

 

[Muhammet Okumuş]

Merhaba aşağıdaki kodu deneyiniz.

Sub analiz()
Range("a3:d1000") = ""
Application.ScreenUpdating = False
Sheets(1).Range("a3:b" & Sheets(1).Range("a10000").End(3).Row).Copy Range("a3")
Sheets(2).Range("a3:b" & Sheets(2).Range("a10000").End(3).Row).Copy Range("a" & Range("a10000").End(3).Row + 1)
For i = Range("b10000").End(3).Row To 3 Step -1
If WorksheetFunction.CountIf(Range("a3:a" & Range("b10000").End(3).Row), Cells(i, 1)) > 1 Then Rows(i).Delete
Next
For j = 3 To Range("b10000").End(3).Row
If WorksheetFunction.CountIf(Sheets(1).Range("a3:a" & Sheets(1).Range("b10000").End(3).Row), Cells(j, 1)) = 0 Then GoTo 10
Cells(j, 3) = WorksheetFunction.Index(Sheets(1).Range("c3:c" & Sheets(1).Range("c10000").End(3).Row), WorksheetFunction.Match(Cells(j, 1), Sheets(1).Range("a3:a" & Sheets(1).Range("a10000").End(3).Row), 0))
10
If WorksheetFunction.CountIf(Sheets(2).Range("a3:a" & Sheets(2).Range("b10000").End(3).Row), Cells(j, 1)) = 0 Then GoTo 20
Cells(j, 4) = WorksheetFunction.Index(Sheets(2).Range("c3:c" & Sheets(2).Range("c10000").End(3).Row), WorksheetFunction.Match(Cells(j, 1), Sheets(2).Range("a3:a" & Sheets(2).Range("a10000").End(3).Row), 0))
20
Next j
For k = Range("b10000").End(3).Row To 3 Step -1
If Cells(k, 3) = Cells(k, 4) Then Rows(k).Delete
Next k
End Sub

 

[acar6783]

cok teşşekur ederim cok guzel olmus ,,

yalnız son olarak soyle bırsey yapabilirmiyiz
eğer hata yoksa ;
hata yok ya da eşleşme tamam gibi bir uyarı tarzı bır sey cıksa olur mu

 

[Muhammet Okumuş]

Sub analiz()
Range("a3:d1000") = ""
Application.ScreenUpdating = False
Sheets(1).Range("a3:b" & Sheets(1).Range("a10000").End(3).Row).Copy Range("a3")
Sheets(2).Range("a3:b" & Sheets(2).Range("a10000").End(3).Row).Copy Range("a" & Range("a10000").End(3).Row + 1)
For i = Range("b10000").End(3).Row To 3 Step -1
If WorksheetFunction.CountIf(Range("a3:a" & Range("b10000").End(3).Row), Cells(i, 1)) > 1 Then Rows(i).Delete
Next
For j = 3 To Range("b10000").End(3).Row
If WorksheetFunction.CountIf(Sheets(1).Range("a3:a" & Sheets(1).Range("b10000").End(3).Row), Cells(j, 1)) = 0 Then GoTo 10
Cells(j, 3) = WorksheetFunction.Index(Sheets(1).Range("c3:c" & Sheets(1).Range("c10000").End(3).Row), WorksheetFunction.Match(Cells(j, 1), Sheets(1).Range("a3:a" & Sheets(1).Range("a10000").End(3).Row), 0))
10
If WorksheetFunction.CountIf(Sheets(2).Range("a3:a" & Sheets(2).Range("b10000").End(3).Row), Cells(j, 1)) = 0 Then GoTo 20
Cells(j, 4) = WorksheetFunction.Index(Sheets(2).Range("c3:c" & Sheets(2).Range("c10000").End(3).Row), WorksheetFunction.Match(Cells(j, 1), Sheets(2).Range("a3:a" & Sheets(2).Range("a10000").End(3).Row), 0))
20
Next j
For k = Range("b10000").End(3).Row To 3 Step -1
If Cells(k, 3) = Cells(k, 4) Then Rows(k).Delete
Next k
Application.ScreenUpdating = True
If Range("b3") = "" Then
MsgBox "!!! Bütün eşleştirmeler tam !!!", vbOKOnly, "SONUÇ"
Else
x = WorksheetFunction.CountA(Range("B3:B1000"))
MsgBox x & " eşleşmeyen bulundu...", vbOKOnly, "SONUÇ"
End If
End Sub

bumu deneyiniz.