Iki Ayri Tablo Ve Farklari

[hayri tekin]

Necdet hocam elinize sağlık,iyi ki varsınız..Bizlerde nacizane sizin gibi ustalardan birşeyler öğrenmeye,kendimizi daha da geliştirmeye çaba gösteriyoruz.
Her iki listede olup da hatalı hücreyi de boyasa ?
Saygılar..

 

[Necdet]

Merhaba,

Sicil ve Tutarı Kontrol Eder.
Hatalı olan kaydı Sayın tekintek için renklendirdim.
Tutarı yanlış olan kaydı Sarı, Hiç olmayan kaydı ise Kırmızı yaptırdım.

Sub Karsilastir()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Set s3 = Sheets("Sayfa3")
s3.Range("A2:D65536").ClearContents
Dim i As Long, Sat As Long
Dim Adet As Integer, Durum As Integer
Application.ScreenUpdating = False
s1.Columns("A:D").Interior.ColorIndex = xlNone  '----Daha Önce Olan renkleri Kaldır
Sat = 1
For i = 2 To s1.[A65536].End(3).Row
    Durum = 0
    Set Bul = s2.Columns(1).Find(s1.Cells(i, "A"))
    If Bul Is Nothing Then
        Durum = 1
    Else
        If s1.Cells(i, "D") <> s2.Cells(Bul.Row, "D") Then
            Durum = 2
        End If
    End If
    
    If Durum > 0 Then
        Sat = Sat + 1
        Adet = Adet + 1
        s3.Cells(Sat, "A") = s1.Cells(i, "A")
        s3.Cells(Sat, "B") = s1.Cells(i, "B")
        s3.Cells(Sat, "C") = s1.Cells(i, "C")
        s3.Cells(Sat, "D") = s1.Cells(i, "D")
        '------------- Renklendirme Başlangıcı -----------------
        If Durum = 1 Then
            s1.Range("A" & i & ":D" & i).Interior.ColorIndex = 3   '-------- Sicil Numarası Yok
        Else
            s1.Range("A" & i & ":D" & i).Interior.ColorIndex = 19   '-------- Sicil Numarası Var Tutar Tutmuyor
        End If
        '------------- Renklendirme Sonu      -----------------
    End If
    
Next i
MsgBox " Sayfa2 de Olmayan " & Adet & " Kişi Buldum ......"
s3.Select
End Sub

 

[senuyurken]

necdet abi cok cok tesekkur ederim... Bu diger iki dosyadan farkli dimi.. Sadece sicil ve tutari kontrol edecek.... Yoksa diger 2 dosya icinde gecerlimi bu... Yaw yine karistirdim ben

1- Iki tablo arasindaki olmayan isimleri sicilleri ile listeledi cok guzel......
2- sicil ad-soyad-tutara gore listeledfi bu da cok cok sahane.....
3- simdide sadece sicil ve tuatara gore listelemesini istiyorum

bu 3 maddeyi tek basinami yapiyor.....

COK COK TESEKKUR EDERIM... ALLAH RAZI OLSUN.....


SELAMETLE

 

[Necdet]

Bu son gönderdiğim dosyada 1 ve 3. maddeleri kontrol ediyor.

Yani Sicili bulamazsa ve Sicil ve Tutarlar eşit değilsenin kontrolü.

Sicili bulamazsa satırı kırmızıya, Sicil var ama Tutar farklı ise satırı Kırmızıya boyuyor.

Listemeyi zaten yapıyor onu söylemeye gerek yok.

 

[senuyurken]

Abi Supersin Ya Az Once Kontrol Ettim.. Allah Razi Olsun Abi Yaaa...1200 Kisi Icerisinde Takir Takir Cikartti Sonuclari.. Benim, Bunu Cikti Uzerinde Kontrol Etmem 3-4 Saatimi Aliyordu...


Allah Razi Olsun Cok Cok Saol.....


DOSYAYI EKLIYORUM BIR BAKARMISIN ABI.......

 

[hayri tekin]

Bu son gönderdiğim dosyada 1 ve 3. maddeleri kontrol ediyor.

Yani Sicili bulamazsa ve Sicil ve Tutarlar eşit değilsenin kontrolü.

Sicili bulamazsa satırı kırmızıya, Sicil var ama Tutar farklı ise satırı Kırmızıya boyuyor.

Listemeyi zaten yapıyor onu söylemeye gerek yok.

Çok teşekkürler Necdet hocam.Değişik kullanım alanları olabilecek bir dosya olduğu için ek istekte bulunmuştum.
Sağlıcakla kalın..

 

[Necdet]

Sayın senuyurken ve Sayın tekintek,

Güle güle kullanınız.

 

[webuyeislemleri]

Merhaba,

Sicil ve Tutarı Kontrol Eder.
Hatalı olan kaydı Sayın tekintek için renklendirdim.
Tutarı yanlış olan kaydı Sarı, Hiç olmayan kaydı ise Kırmızı yaptırdım.

Sub Karsilastir()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Set s3 = Sheets("Sayfa3")
s3.Range("A2:D65536").ClearContents
Dim i As Long, Sat As Long
Dim Adet As Integer, Durum As Integer
Application.ScreenUpdating = False
s1.Columns("A:D").Interior.ColorIndex = xlNone  '----Daha Önce Olan renkleri Kaldır
Sat = 1
For i = 2 To s1.[A65536].End(3).Row
    Durum = 0
    Set Bul = s2.Columns(1).Find(s1.Cells(i, "A"))
    If Bul Is Nothing Then
        Durum = 1
    Else
        If s1.Cells(i, "D") <> s2.Cells(Bul.Row, "D") Then
            Durum = 2
        End If
    End If
    
    If Durum > 0 Then
        Sat = Sat + 1
        Adet = Adet + 1
        s3.Cells(Sat, "A") = s1.Cells(i, "A")
        s3.Cells(Sat, "B") = s1.Cells(i, "B")
        s3.Cells(Sat, "C") = s1.Cells(i, "C")
        s3.Cells(Sat, "D") = s1.Cells(i, "D")
        '------------- Renklendirme Başlangıcı -----------------
        If Durum = 1 Then
            s1.Range("A" & i & ":D" & i).Interior.ColorIndex = 3   '-------- Sicil Numarası Yok
        Else
            s1.Range("A" & i & ":D" & i).Interior.ColorIndex = 19   '-------- Sicil Numarası Var Tutar Tutmuyor
        End If
        '------------- Renklendirme Sonu      -----------------
    End If
    
Next i
MsgBox " Sayfa2 de Olmayan " & Adet & " Kişi Buldum ......"
s3.Select
End Sub

Bende iki Excel sayfası var. Kaynak olarak Sayfa1 kullanrak Sayfa2 sorgulayacak. Sayfa1 deki a kolonunda ki stok koduna karşılık gelen Sayfa2 a kolonundaki stok kodunun B klonundaki fiyatı sayfa1 c klonuna yazmak için nasıl bir yol izlemeliyim.