İki Sayfayı Satır satır karşılaştır farklı satırları yaz

[kykbt]

Arkadaşlar benzer bir sürü sayfayı inceledim sonunda !!döngüsel başvuruya girdim!!!.
Örnekteki dosya için ustalardan yardım istiyorum. İşin içinden çıkamadım. iki aynı olması gereken sayfalar içinde değşmiş bir veri varmı bulmalıyım

 

[Ayhan Ercan]

Merhaba Sn kykbt

İki sayfanızın satır sayıları (275'e 1744) birbirinden cok farklı. Dolayısıyla sayfalar arasında Değişmiş değilde, fazlalık veri kesinlikle vardır diyebiliriz. Sizin tam olarak istediğiniz şey nedir? Değişen veriyi mi yoksa fazladan ilave edilmiş veriyi mi bulmak istiyorsunuz?

 

[kykbt]

Sn Ayhan
İki farklı sayfa iki farklı zamanda kayıt yapılıyor sonra maksat ilk kayıttan sonra bu kayıtlar da değişiklik yapılıyormu bunu kontrol etmemiz gerekiyor.
Yani Sayfa 1 dekilere denk gelen satıra kadar karşılaştırma yapılacak
sayfa 1 de 500 kayıt var ise sayfa 2 den buna denk gelen 500 satır

 

[Ayhan Ercan]

Merhaba,

Aşağıdaki kodları bir düğmeye atayarak çalıştırınız..

Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("sayfa1")
Set s2 = Sheets("sayfa2")
For i = 10 To 264
    For j = 1 To 10
    
    If s1.Cells(i, j).Value <> s2.Cells(i, j).Value Then s1.Cells(i, j).Interior.ColorIndex = 6
    
    Next
Next

Hatalı olan hücreler Sayfa1 de Sarı Renkli Olacaktır...

 

[kykbt]

Sayın Ercan
Öncelikle ilginize teşekkür ederim.
Verdiğiniz kodu çalıştırdım. Ancak başlangıcına Sub ve sonuna End Sub koyarak sanırım burada bir yanlışım yok. Ancak Makro sonunda -Run-time error '9'- ve alt satırında -Subscript out of range- diye bir hata veriyor.
Birde sizden ricam benim istediğim Sayfa 1 deki verilerle aynı olmayan sayfa 2 deki verileri Sayfa 3 e yazması ve hücreyi renklendirmesi sizin verdiğiniz kod ile Sayfa 1 de sayfa 2 deki farklı olan hücreleri renklendiriyor.
Hatta şu olabilirse mükemmel olur. Sayfa 3 e sayfa 1 ile sayfa 2 arasında farklı satırı komple sayfa 3 e yazsın önce sayfa 1 satırını sonra sayfa 2 satırını K sutunundan başlayarak. Şimdiden tekrar teşekkür ediyorum.

 

[Ayhan Ercan]

Merhaba Sn kykbt

Ek Dosyayı İnceleyiniz....

Private Sub CommandButton1_Click()
Dim s1 As Worksheet, s2 As Worksheet, s3 As Worksheet, a As Integer
Set s1 = Sheets("sayfa1")
Set s2 = Sheets("sayfa2")
Set s3 = Sheets("Sayfa3")
a = 10
For i = 11 To 264
    For j = 1 To 10
        If s1.Cells(i, j).Value <> s2.Cells(i, j).Value Then
            s1.Cells(i, j).Interior.ColorIndex = 6
            a = a + 1
            For k = 1 To 10
                s3.Cells(a, k) = s1.Cells(i, k)
                s3.Cells(a, k + 11) = s2.Cells(i, k)
                s3.Cells(a, j).Interior.ColorIndex = 6
                s3.Cells(a, j + 11).Interior.ColorIndex = 6
            Next k
        End If
    Next
Next
Set s1 = Nothing
Set s2 = Nothing
Set s3 = Nothing
End Sub

 

[kykbt]

Sayın Ercan
Verdiğiniz kod kesinlikle çok iyi, fakat sizi biraz daha yoracağım kod üzerinde biraz değişiklik yapıp geliştirmeye çalıştım ancak tam istediğim yere varamadım.
Varmak istediğim sonuc farklı iki satır üzerinde farklardan dolayı oluşan renklendirmeyi aynı satırda yaptırmak. Ancak kod her fark için yeni satır yazıyor. Ben iki satır üzerinde farkları renklendirsin ve ayrıca faklı olan satır nosunu da "A" sutununa yazdırmam gerekli karşılaştırmak istediğim orjinal sayfadaki kayıt sayısı 10.000 in üzerinde dolayısıyla satırı kontrol etmek veya bulmak zor. Birde Sayfa 1 de renklendirilen hücrelerin rengini kod ile silemedim. İlgilenirseniz sevinirim. Örnek sayfayı tekrar yolluyorum.

 

[kykbt]

Syn Ercan müsait bir zamanınızda ilgilenirseniz sevinirim.

 

[kykbt]

Sanırım Syn Ercan hocam müsait değil diğer hocalarım yardım edebilirlerse; önemli!

 

[Ayhan Ercan]

Merhaba Sn kykbt

Benim Müsait olup olmamam mühim değil.

Affınıza sığınarak söylemek istiyorum ki ,

isteğinizi yazdığınız zaman Sn..... kişiye diye hitaben başlamanız bence pek hoş görünmüyor. Tabii bu benim acizane fikrim.

Syn Ercan müsait bir zamanınızda ilgilenirseniz sevinirim.

Bu mesajınızdan sonra hala cevap alamadıysanız emin olun ki sorunuzla yalnızca Syn Ercan ilgilenmemiş, bilakis diğer üstad ve üyelerde cevap vermek istemiştir. Ancak cevap alamadığınıza göre çok büyük bir ihtimalle sorunuz anlaşılmamıştır.

Ben sorunuzu okudum. Emin olmanızı isterimki bu sorunuzdan bişey anlayamadım.

Bu yüzdende şimdiye kadar bu soruya cevap veremedim..
Belki başka bir arkadaş anlar diye ilgimi kestim. Ama anlaşılıyorki diğer arkadaşlar da bişey anlamamış herhalde...

 

[kykbt]

Ercan Hocam evet o ince detayı sanırım kaçırdım ve olay kişiselleşmiş gib oldu. Haklı olabilirsiniz ince düşünceniz için teşekkür ediyorum.
Problemimi yeni ek ile tekrar yolluyorum. Burada istediğim tablo; Sayfa4 teki gibi olsun istiyorum. Ayrıca her makro çalıştırıldığında Sayfa1 ve Sayfa2 deki eskiden kalma renklendirmeleri silip yeniden renklendirsin istiyorum. İlgilenen ustadlara şimdiden teşekkür ediyorum.

 

[Ayhan Ercan]

Merhaba Sn kykbt

Sanırım isteğinizi çözebildim.
Ek Dosyayı İnceleyiniz.....

Private Sub CommandButton1_Click()
Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet, a As Integer, b As Integer
Set S1 = Sheets("sayfa1")
Set S2 = Sheets("sayfa2")
Set S3 = Sheets("sayfa3")
    S1.Cells.Interior.ColorIndex = xlNone
    S2.Cells.Interior.ColorIndex = xlNone
    S3.Cells.Interior.ColorIndex = xlNone
    S3.Cells.ClearContents
    a = 5
For i = 14 To 264
    For j = 1 To 10
        If S1.Cells(i, j).Value <> S2.Cells(i, j).Value Then
            For k = 1 To 11
                S3.Cells(a, k + 1) = S1.Cells(i, k)
                S3.Cells(a + 1, k + 1) = S2.Cells(i, k)
            Next k
                S1.Cells(i, j).Interior.ColorIndex = 6
                S2.Cells(i, j).Interior.ColorIndex = 6
                S3.Cells(a, 1) = S1.Cells(i, 1).Row
                S3.Cells(a + 1, 1) = S1.Cells(i, 1).Row
                S3.Cells(a, j + 1).Interior.ColorIndex = 6
                S3.Cells(a + 1, j + 1).Interior.ColorIndex = 6
        End If
    Next
    If Cells(a, 1) <> "" Then a = a + 3
Next
Set S1 = Nothing
Set S2 = Nothing
Set S3 = Nothing
End Sub

 

[kykbt]

Tek Kelime Benim için mükemmel, Allah size sağlıkla yaşamayı nasip etsin

 

[Ayhan Ercan]

Tek Kelime Benim için mükemmel, Allah size sağlıkla yaşamayı nasip etsin

Cümlemize nasip etsin inşallah....
İyi Çalışmalar... k::