2 listeyi 2 ayrı kriterle değerlendirmek

[sbayyigit]

ekli excel tablosunda ;
sayfa1 ve sayfa2 de 2 ayrı listem var
ben birinci sayfadaki(sayfa1)listeyi sayfa2 deki liste ile karşılaştırıp (a sütunundaki isimlere göre) sayfa2 de var olan değerleri bulup E sütununa "var" veye" bulunamadı" diye yazdırıyorum.
Yapmak isteyip de yapamadığım şey
a sütunları ile b sütunundaki Tarih değerlerinin de karşılaştırdıktan sonra aynı ise "var" veya "bulunamadı" şeklinde yazdırabilmek.

 

[Ömer]

ekli excel tablosunda ;
sayfa1 ve sayfa2 de 2 ayrı listem var
ben birinci sayfadaki(sayfa1)listeyi sayfa2 deki liste ile karşılaştırıp (a sütunundaki isimlere göre) sayfa2 de var olan değerleri bulup E sütununa "var" veye" bulunamadı" diye yazdırıyorum.
Yapmak isteyip de yapamadığım şey
a sütunları ile b sütunundaki Tarih değerlerinin de karşılaştırdıktan sonra aynı ise "var" veya "bulunamadı" şeklinde yazdırabilmek.

Merhaba,

Bu şekilde deneyin.

Sub Karsilastir()
 
    Dim S2 As Worksheet, i As Long, c As Range, Adr As String
 
    Set S2 = Sheets("Sayfa2")
    Sheets("Sayfa1").Select
 
    Range("E2:E" & Rows.Count).ClearContents
 
    For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        With S2.Range("A:A")
            Set c = .Find(Cells(i, "A"), , xlValues, xlWhole)
            If Not c Is Nothing Then
                Adr = c.Address
                Do
                    If S2.Cells(c.Row, "B") = Cells(i, "B") Then
                        Cells(i, "E") = "Var"
                        [COLOR=blue]Exit Do[/COLOR]
                    Else
                        Cells(i, "E") = "Bulunamadı"
                    End If
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> Adr
            Else
                Cells(i, "E") = "Bulunamadı"
            End If
        End With
    Next i
 
End Sub

.

 

[sbayyigit]

ömer hocam öncelikle ilgin için teşekkür ederim.

kodlar istediğim gibi çalışıyor.fakat

a sütunundaki isim birden fazla tekarar ediyorsa ikinci şartı sağlamasına rağmen bulunamadı diyor.

kıyaslama yapacağım iki sayfa aynı olmasına rağmen aynı isimlerin ilkine bulunamdı. diyor.

test etmek için sayfa1 i olduğu gibi kopyalayıp sayfa2 ye yapıştırdıktan sonra deneyebilirsiniz.

Kodları çözemediğim için var olan bir hatayı bulamadım.

iyi çalışmalar dileğiyle...

 

[Ömer]

Hatalı sonuçları daha kolay görebilmem için hatalı sonuç aldığınız satır numaralarının birkaç tanesini yazarmısınız.

 

[mnrs_]

Office 2007 ve 2010'da şu fonksiyonla deneyebilirsiniz;

=EĞER(ÇOKEĞERSAY(Sayfa2!A:A;Sayfa1!A2;Sayfa2!B:B;Sayfa1!B2;Sayfa2!C:C;Sayfa1!C2)=0;"Bulunamadı";"Var")

Makro ile çözmek isterseniz bu kodla deneyebilirsiniz?

Sub compare()
    Sheets("Sayfa1").Select
    Set alan = Cells(1, 1).CurrentRegion
    sonsatir = alan.Rows.Count
    Range("E2:E" & Rows.Count).ClearContents
    For i = 2 To sonsatir
        Sheets("Sayfa1").Select
        isim1 = Cells(i, 1).Value
        If isim1 = "" Then Exit For
        tarih11 = Cells(i, 2).Value
        tarih12 = Cells(i, 3).Value
        Set alan2 = Sheets("Sayfa2").Cells(1, 1).CurrentRegion
        sonsatir2 = alan2.Rows.Count + 1
        For j = 1 To sonsatir2
            isim2 = Sheets("Sayfa2").Cells(j, 1).Value
            tarih21 = Sheets("Sayfa2").Cells(j, 2).Value
            tarih22 = Sheets("Sayfa2").Cells(j, 3).Value
            If isim1 = isim2 And tarih11 = tarih21 And tarih12 = tarih22 Then
                Sheets("Sayfa1").Cells(i, 5).Value = "Var"
                Exit For
            End If
            If isim2 = "" Then
                Sheets("Sayfa1").Cells(i, 5).Value = "Bulunamadı"
            End If
        Next j
    Next i
End Sub

 

[sbayyigit]

Hatalı sonuçları daha kolay görebilmem için hatalı sonuç aldığınız satır numaralarının birkaç tanesini yazarmısınız.

ömer hocam kusura bakma; biraz geç oldu.

dosyayı ekliyorum. her 2 sayfa aynı olduğu halde 6-14-30-32-51-54-55-76-78-79 nolu satırlarda "bulunamadı diyor"

Office 2007 ve 2010'da şu fonksiyonla deneyebilirsiniz;

=EĞER(ÇOKEĞERSAY(Sayfa2!A:A;Sayfa1!A2;Sayfa2!B:B;Sayfa1!B2;Sayfa2!C:C;Sayfa1!C2)=0;"Bulunamadı";"Var")

Makro ile çözmek isterseniz bu kodla deneyebilirsiniz?

Sub compare()
    
End Sub

mnrs hocam sizin kodunuz sorunsuz çalıştı elinize sağlık ama satır sayısı çok fazla olduğu için çok takılıyor. elinize sağlık.

 

[Ömer]

#2 numaralı mesajı düzenledim. Tekrar deneyin.

 

[sbayyigit]

#2 numaralı mesajı düzenledim. Tekrar deneyin.

elinize sağlık. çok teşekkür.