Tarihleri ayrı sayfalarda bulunması hk.

[1903emre34@gmail.com]

Merhaba

Sayfa1'de yer alan tarihler, sayfa2 ve sayfa3 yer aldığı takdirde olanların sarı ile boyanması için kod oluşturabiliriz.

 

[YUSUF44]

Koşullu biçimlendirmede başka sayfaların kontrolü için ad tanımlama kullanmalısınız. Ad tanımlamada yeni ad tanımlayın, adı tarih2 olsun ve formülü:

=DOLAYLI("Sayfa2!$A$1:$A$"&BAĞ_DEĞ_DOLU_SAY(Sayfa2!$A:$A))

olsun. Bir de tarih3 diye ad tanımlayın, onun da formülü:

=DOLAYLI("Sayfa3!$A$1:$A$"&BAĞ_DEĞ_DOLU_SAY(Sayfa3!$A:$A))

olsun.

Koşullu biçimlendirme için Sayfa1'de A1'den itibaren aşağı doğru istediğiniz kadar seçin ve koşullu biçimlendirme formülü olarak aşağıdaki formülü kullanıp, biçim ayarını yapın:

=YADA(EĞERSAY(tarih2;A1)>0;EĞERSAY(tarih3;A1)>0)

 

[1903emre34@gmail.com]

Yusuf bey, teşekkürler. çalıştı, sayfa sayısı çok, makro yoluyla mümkün mü?

 

[YUSUF44]

Sub tarihrenkle()
Set s1 = Sheets("Sayfa1")
son = s1.Cells(Rows.Count, "A").End(3).Row
Application.ScreenUpdating = False
    For Each hucre In s1.Range("A1:A" & son)
        For sayfa = 1 To Sheets.Count
            If Sheets(sayfa).Name <> s1.Name Then
                sonsat = Sheets(sayfa).Cells(Rows.Count, "A").End(3).Row
                If WorksheetFunction.CountIf(Sheets(sayfa).Range("A1:A" & sonsat), hucre.Value) > 0 Then
                    hucre.Interior.Color = vbYellow
                    sayfa = Sheets.Count
                End If
            End If
        Next
    Next
Application.ScreenUpdating = True
End Sub

 

[1903emre34@gmail.com]

Yusuf bey, sayfa1 sarı ile boyanmış hücrelerin yanına ayfa isimleri gelmesi için yapabilir miyiz

 

[YUSUF44]

Birden fazla sayfada varsa tüm sayfaların adı mı yazılacak? Yazıalcaksa nasıl yazılacak ayrı hücrelere mi, aynı hücrede mi? Aynı hücredeyse ayırıcı ne olacak?

 

[1903emre34@gmail.com]

Aynı hücrede, ayırıcı -- şeklinde

ilginiz için teşekkürler.

 

[YUSUF44]

Deneyiniz:

Sub tarihrenkle()
Set s1 = Sheets("Sayfa1")
son = s1.Cells(Rows.Count, "A").End(3).Row
Application.ScreenUpdating = False
    For Each hucre In s1.Range("A1:A" & son)
        For sayfa = 1 To Sheets.Count
            If Sheets(sayfa).Name <> s1.Name Then
                sonsat = Sheets(sayfa).Cells(Rows.Count, "A").End(3).Row
                If WorksheetFunction.CountIf(Sheets(sayfa).Range("A1:A" & sonsat), hucre.Value) > 0 Then
                    hucre.Interior.Color = vbYellow
                    If hucre.Offset(0, 1) = "" Then
                        hucre.Offset(0, 1) = Sheets(sayfa).Name
                    Else
                        hucre.Offset(0, 1) = hucre.Offset(0, 1) & "-" & Sheets(sayfa).Name
                    End If
                End If
            End If
        Next
    Next
Application.ScreenUpdating = True
End Sub