İki sayfa arasında karşılaştırma yapıp üçüncü sayfaya yazdırmak için ne yapmalıyım?

[asliiylmaz]

Arkadaşlar merhaba,
Ben iki sayfanın 1.sutünları arasında karşılaştırma yapıp 3. sayfaya yazdırmak istiyorum.
Örneğin;
1. Sayfa 2. Sayfa
Masa124 Masa124
Kitap3345
Kalem435

İki sayfada da Masa124 olduğu için 3. sayfaya bunu renkli yazdırmak istiyorum. Geriye kalan veriler de aynı şekilde yazılsın. Bunu nasıl yapabilirim?

 

[muygun]

Örnek dosyanızı;
http://dosya.co/
Adresine ekleyip linkini burada paylaşarak...
Yada altın üye olarak dosya örneğinizi burada paylaşarak.

 

[asliiylmaz]

http://dosya.co/grq32qckp0px/DENEME.xlsx.html

 

[asliiylmaz]

Örnek dosyanızı;
http://dosya.co/
Adresine ekleyip linkini burada paylaşarak...
Yada altın üye olarak dosya örneğinizi burada paylaşarak.

http://dosya.co/grq32qckp0px/DENEME.xlsx.html

 

[Orion1]

Dosyanız aşağıdaki linktedir.

Sub aynisi59()
Dim s1 As Worksheet, s2 As Worksheet, k As Range, sat As Long
Dim sonsat1 As Long, sonsat2 As Long
Sheets("Sayfa3").Select
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
sat = 1
sonsat1 = s1.Cells(Rows.Count, "A").End(xlUp).Row
sonsat2 = s2.Cells(Rows.Count, "A").End(xlUp).Row
Range("A:A").Clear
Application.ScreenUpdating = False
For i = 2 To sonsat1
    Cells(sat, "A").Value = s1.Cells(i, "A").Value
    Set k = s2.Range("A2:A" & sonsat2).Find(s1.Cells(i, "A").Value, , xlValues, xlWhole)
    If Not k Is Nothing Then
        Range("A" & sat).Interior.Color = vbBlack
        Range("A" & sat).Font.Color = vbGreen
        Range("A" & sat).Font.Bold = True
    End If
    sat = sat + 1
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamamdır." & vbLf & "evrengizlen@hotmail.com"
End Sub

DOSYAYI INDIR

 

[asliiylmaz]

Dosyanız aşağıdaki linktedir.

Sub aynisi59()
Dim s1 As Worksheet, s2 As Worksheet, k As Range, sat As Long
Dim sonsat1 As Long, sonsat2 As Long
Sheets("Sayfa3").Select
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
sat = 1
sonsat1 = s1.Cells(Rows.Count, "A").End(xlUp).Row
sonsat2 = s2.Cells(Rows.Count, "A").End(xlUp).Row
Range("A:A").Clear
Application.ScreenUpdating = False
For i = 2 To sonsat1
    Cells(sat, "A").Value = s1.Cells(i, "A").Value
    Set k = s2.Range("A2:A" & sonsat2).Find(s1.Cells(i, "A").Value, , xlValues, xlWhole)
    If Not k Is Nothing Then
        Range("A" & sat).Interior.Color = vbBlack
        Range("A" & sat).Font.Color = vbGreen
        Range("A" & sat).Font.Bold = True
    End If
    sat = sat + 1
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamamdır." & vbLf & "evrengizlen@hotmail.com"
End Sub

DOSYAYI INDIR

Çok teşekkür ederim kodları da yollamışsınız. Şu an yeni başlıyorum bwn exceli bu kadar detaylı kullanmaya yaptığınız olay makro oluyor sanırım. Bunun haricinde bir yol var mıdır?

 

[Orion1]

Çok teşekkür ederim kodları da yollamışsınız. Şu an yeni başlıyorum bwn exceli bu kadar detaylı kullanmaya yaptığınız olay makro oluyor sanırım. Bunun haricinde bir yol var mıdır?

Sayfaya butonda koydum.Butona basarak kodları çalıştırabilirsiniz.
Formüllerle yapılmasını istiyorsanız sorunuzu Fonksiyonlar bölümünde sorunuz.

 

[asliiylmaz]

Sayfaya butonda koydum.Butona basarak kodları çalıştırabilirsiniz.
Formüllerle yapılmasını istiyorsanız sorunuzu Fonksiyonlar bölümünde sorunuz.

Çok teşekkür ederim yardımınız için

 

[Orion1]

Çok teşekkür ederim yardımınız için

Rica ederim.
İyi çalışmalar.

 

[asliiylmaz]

Dosyanız aşağıdaki linktedir.

Sub aynisi59()
Dim s1 As Worksheet, s2 As Worksheet, k As Range, sat As Long
Dim sonsat1 As Long, sonsat2 As Long
Sheets("Sayfa3").Select
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
sat = 1
sonsat1 = s1.Cells(Rows.Count, "A").End(xlUp).Row
sonsat2 = s2.Cells(Rows.Count, "A").End(xlUp).Row
Range("A:A").Clear
Application.ScreenUpdating = False
For i = 2 To sonsat1
    Cells(sat, "A").Value = s1.Cells(i, "A").Value
    Set k = s2.Range("A2:A" & sonsat2).Find(s1.Cells(i, "A").Value, , xlValues, xlWhole)
    If Not k Is Nothing Then
        Range("A" & sat).Interior.Color = vbBlack
        Range("A" & sat).Font.Color = vbGreen
        Range("A" & sat).Font.Bold = True
    End If
    sat = sat + 1
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamamdır." & vbLf & "evrengizlen@hotmail.com"
End Sub

DOSYAYI INDIR

Tekrar rahatsız ediyorum ama ben bu makroyu butonsuz nasıl çalıştırabilirim. 3. sayfaya geldiğimde karşılaştırma yapmış ve renklenmiş olsun istiyorum

 

[Orion1]

Tekrar rahatsız ediyorum ama ben bu makroyu butonsuz nasıl çalıştırabilirim. 3. sayfaya geldiğimde karşılaştırma yapmış ve renklenmiş olsun istiyorum

Dosyanız aşağıdaki linktedir.

DOSYAYI INDIR

Sub aynisi59()
Dim s1 As Worksheet, s2 As Worksheet, k As Range, sat As Long
Dim sonsat1 As Long, sonsat2 As Long
Sheets("Sayfa3").Select
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
sat = 1
sonsat1 = s1.Cells(Rows.Count, "A").End(xlUp).Row
sonsat2 = s2.Cells(Rows.Count, "A").End(xlUp).Row
Range("A:A").Clear
Application.ScreenUpdating = False
For i = 2 To sonsat1
    Cells(sat, "A").Value = s1.Cells(i, "A").Value
    Set k = s2.Range("A2:A" & sonsat2).Find(s1.Cells(i, "A").Value, , xlValues, xlWhole)
    If Not k Is Nothing Then
        Range("A" & sat).Interior.Color = vbBlack
        Range("A" & sat).Font.Color = vbGreen
        Range("A" & sat).Font.Bold = True
    End If
    sat = sat + 1
Next i
Application.ScreenUpdating = True
End Sub

 

[mzsakall]

tüm sayfada ki verileri nasıl karşıalştırabiliriz