• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Ayrı Sayfalardaki Verileri Tutara Göre Karşılaştırma

Trilenium

Destek Ekibi
Destek Ekibi
Katılım
16 Eylül 2008
Mesajlar
1,300
Excel Vers. ve Dili
Microsoft Office 2019 English
Merhabalar,

Ekte sunmuş olduğum dosya da görüleceği üzere 2 adet sayfam var.

A ve B sayfalarını birbiri ile karşılaştırma yapmak istiyorum.

A sayfasındaki Tutarı B sayfasında var ise kontrol adlı sütuna "Var,Yok" ve bulduğu tutarın yanına da "Bulundu" ibaresini yazdırmak istiyorum

Fakat burada ince bir nüans var, Aramayı yaparken şunu göz önünde bulundurmak istiyorum.

Örneğin A sayfasında 5000 TL var, bu tutarı B sayfasında aradım ve ilk bulduğum 5000 TL ile bu tutarı hemen eşleştirmek istiyorum ve yukarıda bahsettiğim gibi Kontrol adlı sütuna Var,Yok ibaresi yazdırmalıyım. Aksi takdir de başka bir 5000 TL daha var olacağı için o tutarı arama yaparken tekrar görebilecektir.


Konu hakkında Örnek sheetler yaptım.

* Site içerisinde aramalar yaptım fakat sanırım sonuca gidecek kodları bulamadım. İstediğim şey VBA ortamında olmalıdır.

Yardımlarınız için şimdiden teşekkürler

Saygılarımla
 

Ekli dosyalar

Merhaba,

İstediğiniz bu mu?

Kod:
Sub Karsilastir()

    Dim Sb As Worksheet, i As Long, c As Range, Adr As String
    
    Set Sb = Sheets("B")
    
    Application.ScreenUpdating = False
    Sheets("A").Select
    Range("C2:C" & Rows.Count).ClearContents
    Sb.Range("C2:C" & Rows.Count).ClearContents
   
    For i = 2 To Cells(Rows.Count, "B").End(xlUp).Row
        Set c = Sb.[B:B].Find(Cells(i, "B"), , xlFormulas, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                If Sb.Cells(c.Row, "C") = "" Then
                    Cells(i, "C") = "Bulundu"
                    Sb.Cells(c.Row, "C") = "Var"
                    Exit Do
                End If
                Set c = Sb.[B:B].FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    Next i
        
End Sub

.
 
Ömer Bey merhaba,

Emeğiniz için teşekkür ederim. Şu an için olmuş gözükmektedir.

İyi günler,
Kolay gelsin
 
Ömer Bey merhabalar,

Eğer aranacak kolonlar farklı olsaydı ne yapmalıydık ?

Örneğin ;

A Sheetinde Tutar G kolonunda
B Sheetinde Tutar C kolonunda olsaydı kodu nasıl düzenlememiz gerekecekti.

Teşekkürler
 
Merhaba,

Sütun isimlerini değişkene tanımladım.
s1,s2,s3,s4 tanımlamalarındaki sütun isimlerini (Kırmızı adları) kendinize göre uyarlarsınız.

Kod:
Private Sub CommandButton1_Click()

    Dim Sb As Worksheet, i As Long, c As Range, Adr As String
    Dim s1 As String, s2 As String, s3 As String, s4 As String
    
    Set Sb = Sheets("B")
    
    s1 = "G" 'A sayfası aranan sütun
    s2 = "I" 'A sayfası sonucların yazıldığı sütun
    s3 = "C" 'B sayfası aranan sütun
    s4 = "G" 'B ssayfası sonucların yazıldığı sütun
    
    Application.ScreenUpdating = False
    Sheets("A").Select
    
    Range(s2 & 2 & ":" & s2 & Rows.Count).ClearContents
    Sb.Range(s4 & 2 & ":" & s4 & Rows.Count).ClearContents
   
    For i = 2 To Cells(Rows.Count, s1).End(xlUp).Row
        Set c = Sb.Columns(s3).Find(Cells(i, s1), , xlFormulas, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                If Sb.Cells(c.Row, s4) = "" Then
                    Cells(i, s2) = "Bulundu"
                    Sb.Cells(c.Row, s4) = "Var"
                    Exit Do
                End If
                Set c = Sb.Columns(s3).FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    Next i
    
End Sub

.
 
Ömer Bey merhaba

Denedim fakat çalışmadı.

Dosya ektedir.
 

Ekli dosyalar

Harf hatası yapmışım. #5 numaralı mesajı güncelledim. Yeni kodları deneyin.

.
 
Ellerinize sağlık. Çok teşekkür ederim
 
Geri
Üst