aynı calısma kitabındaki 2 farklı sayfada aynı verileri bulup işaretleme

[oornek1]

merhaba arkadaslar bir çalışma kitabında sayfa1 ile sayfa2 deki veriler arasında A1; A65536 hücresinde arama yaparak iki sayfadaki aynı değerleri bulupta her iki sayfadada bu değerleri renklendirebileceğim bir makro yada bir VBA kodu varmı çok acil olarak gerekli... örnek dosya ekte vardır lütfen yardım edin...

 

[mesuttasar]

Aslında for next döngüsü ile çözüm bulunabilir ama aralık çok geniş olacağından bu işlem uzun sürer diye düşünüyorum. Sanırım bu yüzden For Each döngüsü daha mantıklı bi çözüm olur. Deneyeceğim.

 

[oornek1]

tamam hocam siz daha iyi blirsiniz size hangisi uygunsa daha önce dEdE rumuzlu bir abimiz bu konuda yardım etti; aşağıdaki makroyu kullanarak yardımcı oldu ama bu makroda tarama yaptığımda olmayanı buluyorum aynı zamandada olanıda buluyor... dEdE rumuzlu hocamın bana gönderdiği dosyayı burdan eklerim ama dosyadaki bilgiler gerçek bilgiler olduğu için yayınlamam konusunda bir uyarı maili aldım bu yüzden bırakmıyorum...

Sub OlmayanıBul()
Set s1 = Sheets(1)
Set s2 = Sheets(2)

For i = 2 To s1.[B65536].End(3).Row
For k = 2 To s2.[B65536].End(3).Row
Cells(1, 9).Value = i
If s1.Cells(i, 2).Value = s2.Cells(k, 2).Value And s1.Cells(i, 3).Value = s2.Cells(k, 3).Value And s1.Cells(i, 6).Value = s2.Cells(k, 7).Value Then
s1.Range("A" & i & ":L" & i).Interior.ColorIndex = 6
s1.Cells(i, 12).Value = k
End If
Next
Next i
End Sub

 

[mesuttasar]

Her ne kadar for each ile yapmayı denesemde başaramadım.For next çözümünü aşağıdaki kodlarla yapabilirsiniz. Aşağıdaki kodlarla sayfa1 ve sayfa2 deki A sütununda aynı olan hücreler kırmızı ile dolduruluyor.

Sub deneme2()
x = Sheets("sayfa1").[a65536].End(3).Row
y = Sheets("sayfa2").[a65536].End(3).Row
Set s1 = Sheets("sayfa1")
Set s2 = Sheets("sayfa2")
For i = 2 To x
For j = 2 To y
    If s1.Cells(i, 1).Value = s2.Cells(j, 1).Value Then
    [COLOR=Red] s1.Select[/COLOR]
    Cells(i, 1).Select
       With Selection.Interior
        .Color = 255
        End With
[COLOR=Red]
s2.Select[/COLOR]
   Cells(j, 1).Select
    With Selection.Interior
        .Color = 255
        End With
    End If
Next j
Next i
[COLOR=Red] [COLOR=Black]s1.Select[/COLOR][/COLOR]
End Sub

Not: Kırmız renkli kodları ilave ederek her iki sayfada renklendirme yapabilirsiniz.

 

[mesuttasar]

Örnek dosyayı ekliyorum.Sonucu bildirirseniz sevinirim.

 

[ikaramaz]

Örnek dosyayı ekliyorum.Sonucu bildirirseniz sevinirim.

Hocam vermiş olduğunuz örnek ilgimi çekti. Harika olmuş. Ancak ben bu konu ile ilgili yaptığınız çalışmada bir şey sormak istiyorum.

Aynı olarak bulunan verilerin farklı renklerde gösterilmesi mümkün mü acaba?

Çok teşekkür ediyorum. Saygılarımla

 

[mesuttasar]

Hocam vermiş olduğunuz örnek ilgimi çekti. Harika olmuş. Ancak ben bu konu ile ilgili yaptığınız çalışmada bir şey sormak istiyorum.

Aynı olarak bulunan verilerin farklı renklerde gösterilmesi mümkün mü acaba?

Çok teşekkür ediyorum. Saygılarımla

Aşağıdaki gibi deneyin.Aynı hücreleri aynı renge boyuyor.Bu şekilde farklı hücrelerle dolgu yapılabilir.Ekli dosyayı inceleyin.

Sub deneme2()
x = Sheets("sayfa1").[a65536].End(3).Row
y = Sheets("sayfa2").[a65536].End(3).Row
Set s1 = Sheets("sayfa1")
Set s2 = Sheets("sayfa2")
For i = 2 To x
For j = 2 To y
    If s1.Cells(i, 1).Value = s2.Cells(j, 1).Value Then
    [COLOR=Red] s1.Select[/COLOR]
    Cells(i, 1).Select
       With Selection.Interior
        .Color = 255 [B][COLOR=Navy]'<--------Bu satırı .colorIndex=i olarak değiştirin.
[/COLOR][/B]       End With
[COLOR=Red]
s2.Select[/COLOR]
   Cells(j, 1).Select
    With Selection.Interior
        .Color = 255 [B][COLOR=Navy]'<--------Bu satırı .colorIndex=i olarak değiştirin.[/COLOR][/B]
        End With
    End If
Next j
Next i
[COLOR=Red] [COLOR=Black]s1.Select[/COLOR][/COLOR]
End Sub

 

[oornek1]

Örnek dosyayı ekliyorum.Sonucu bildirirseniz sevinirim.

hocam eline sağlık tam olarak istediğimde böle bişeydi cok tesekkur ediyorum...

 

[mesuttasar]

Rica ederim.İyi çalışmalar.