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

Katılım
18 Temmuz 2018
Mesajlar
6
Excel Vers. ve Dili
excell 2007
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

Özel Üye
Katılım
6 Temmuz 2004
Mesajlar
9,104
Excel Vers. ve Dili
Excel-2003 Türkçe
Örnek dosyanızı;
http://dosya.co/
Adresine ekleyip linkini burada paylaşarak...
Yada altın üye olarak dosya örneğinizi burada paylaşarak.
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Dosyanız aşağıdaki linktedir.:cool:

Kod:
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
 

Ekli dosyalar

Katılım
18 Temmuz 2018
Mesajlar
6
Excel Vers. ve Dili
excell 2007
Dosyanız aşağıdaki linktedir.:cool:

Kod:
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

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Ç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.:cool:
 
Katılım
18 Temmuz 2018
Mesajlar
6
Excel Vers. ve Dili
excell 2007
Dosyanız aşağıdaki linktedir.:cool:

Kod:
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

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
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.:cool:

DOSYAYI INDIR

Kod:
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
 

Ekli dosyalar

mzsakall

Altın Üye
Katılım
6 Şubat 2018
Mesajlar
109
Excel Vers. ve Dili
Excel 2010
tüm sayfada ki verileri nasıl karşıalştırabiliriz
 
Üst