Koşullu biçimlendirmeyi diğer sayfalara uygulama

E

euphrates55

Katılım
25 Ocak 2006
Mesajlar
763
Excel Vers. ve Dili
2019 tr
Altın Üyelik Bitiş Tarihi
04-01-2024
Merhaba, bir sekmeme 2 adet formüllü koşullu biçimlendirmem var ve diğer tüm sayfalara aynısını yapmak istiyorum, ancak bir çok sekmede bunu yapmam çok zaman alacaktır dolayısı ile kolayını arıyorum. biçim boyayıcısı ile olmuyor, birleştirilmiş hücre vs gibi durumlardan dolayı ya da satırların biçiminin bozulmasından dolayı olmuyor. var mı acaba kolay yolu?

iki formüllü biçimlendirme olacak:
1. =EĞER((EĞERSAY($A9;"*TOPLAM"))>=1;1)
2. =EĞER((EĞERSAY($A9;"*TOPLAMı"))>=1;1)

iki formülünde uygulama alanı $A$9:$U$350 olacak
 
Son düzenleme:
M

muhasebeciyiz

Altın Üye
Katılım
10 Şubat 2006
Mesajlar
559
Excel Vers. ve Dili
Office 2016
64 Bit
Altın Üyelik Bitiş Tarihi
21-12-2027
Kod: 
Sub Biçimlendir()
    Dim Satır As Integer
    Dim Sutun As Integer
    Dim SonSatır As Integer
    Dim SonSutun As Integer

    SonSatır = 350
    SonSutun = 21
   
    For Satır = 9 To SonSatır
        For Sutun = 1 To SonSutun
           
            If Application.WorksheetFunction.CountIf(Range("A" & Satır & ":U" & Satır), "*TOPLAM") >= 1 Then
                Cells(Satır, Sutun).Interior.ColorIndex = 6
            End If
           
            If Application.WorksheetFunction.CountIf(Range("A" & Satır & ":U" & Satır), "*TOPLAMı") >= 1 Then
                Cells(Satır, Sutun).Interior.ColorIndex = 8
            End If
        Next Sutun
    Next Satır
End Sub
Kod: 
Sub KBiçimlendirme()
    Dim Satır As Integer
    Dim Sutun As Integer
    Dim SonSatır As Integer
    Dim SonSutun As Integer
   
    SonSatır = 350
    SonSutun = 21
   
    For Satır = 9 To SonSatır
       
        If Application.WorksheetFunction.CountIf(Range("A" & Satır & ":U" & Satır), "*TOPLAM") >= 1 Then
            For Sutun = 1 To SonSutun
                If Cells(Satır, Sutun).Value Like "*TOPLAM*" Then
                    Cells(Satır, Sutun).Interior.Color = RGB(0, 255, 0)
                End If
            Next Sutun
        ElseIf Application.WorksheetFunction.CountIf(Range("A" & Satır & ":U" & Satır), "*TOPLAMı") >= 1 Then
           
            For Sutun = 1 To SonSutun
                If Cells(Satır, Sutun).Value Like "*TOPLAMı*" Then
                    Cells(Satır, Sutun).Interior.Color = RGB(255, 0, 0)
                End If
            Next Sutun
        End If
    Next Satır
End Sub
Modül içine kopyalayıp her bir sayfada makroyu çalıştırınız.
A9'dan U350'ye kadar olan hücreler içinde TOPLAM bulduğunda SARI renge boyayacak TOPLAMı bulduğunda mavi renge boyayacaktır.
 
E

euphrates55

Katılım
25 Ocak 2006
Mesajlar
763
Excel Vers. ve Dili
2019 tr
Altın Üyelik Bitiş Tarihi
04-01-2024
muhasebeciyiz' Alıntı:
Kod: 
Sub Biçimlendir()
    Dim Satır As Integer
    Dim Sutun As Integer
    Dim SonSatır As Integer
    Dim SonSutun As Integer

    SonSatır = 350
    SonSutun = 21
  
    For Satır = 9 To SonSatır
        For Sutun = 1 To SonSutun
          
            If Application.WorksheetFunction.CountIf(Range("A" & Satır & ":U" & Satır), "*TOPLAM") >= 1 Then
                Cells(Satır, Sutun).Interior.ColorIndex = 6
            End If
          
            If Application.WorksheetFunction.CountIf(Range("A" & Satır & ":U" & Satır), "*TOPLAMı") >= 1 Then
                Cells(Satır, Sutun).Interior.ColorIndex = 8
            End If
        Next Sutun
    Next Satır
End Sub
Kod: 
Sub KBiçimlendirme()
    Dim Satır As Integer
    Dim Sutun As Integer
    Dim SonSatır As Integer
    Dim SonSutun As Integer
  
    SonSatır = 350
    SonSutun = 21
  
    For Satır = 9 To SonSatır
      
        If Application.WorksheetFunction.CountIf(Range("A" & Satır & ":U" & Satır), "*TOPLAM") >= 1 Then
            For Sutun = 1 To SonSutun
                If Cells(Satır, Sutun).Value Like "*TOPLAM*" Then
                    Cells(Satır, Sutun).Interior.Color = RGB(0, 255, 0)
                End If
            Next Sutun
        ElseIf Application.WorksheetFunction.CountIf(Range("A" & Satır & ":U" & Satır), "*TOPLAMı") >= 1 Then
          
            For Sutun = 1 To SonSutun
                If Cells(Satır, Sutun).Value Like "*TOPLAMı*" Then
                    Cells(Satır, Sutun).Interior.Color = RGB(255, 0, 0)
                End If
            Next Sutun
        End If
    Next Satır
End Sub
Modül içine kopyalayıp her bir sayfada makroyu çalıştırınız.
A9'dan U350'ye kadar olan hücreler içinde TOPLAM bulduğunda SARI renge boyayacak TOPLAMı bulduğunda mavi renge boyayacaktır.
Genişletmek için tıkla ...
teşekkürler. süper oldu..
 
E

euphrates55

Katılım
25 Ocak 2006
Mesajlar
763
Excel Vers. ve Dili
2019 tr
Altın Üyelik Bitiş Tarihi
04-01-2024
günaydın, böyle de çok uzun sürecek gibi. bunu her sayfaya uygulayacak bir kod olsa süper olur. bir de çok yavaş yapmaya başladı, biraz değiştim kodları ama yavaşlama sebebi değildir diye düşünüyorum. son hali
Kod: 
Sub Biçimlendir()
    Dim Satır As Integer
    Dim Sutun As Integer
    Dim SonSatır As Integer
    Dim SonSutun As Integer

    SonSatır = 350
    SonSutun = 21
  
    For Satır = 9 To SonSatır
        For Sutun = 1 To SonSutun
          
            If Application.WorksheetFunction.CountIf(Range("A" & Satır & ":U" & Satır), "*TOPLAM") >= 1 Then
                Cells(Satır, Sutun).Interior.ColorIndex = 9
                Cells(Satır, Sutun).Font.ColorIndex = 2
                Cells(Satır, Sutun).Font.Bold = True
            End If
          
            If Application.WorksheetFunction.CountIf(Range("A" & Satır & ":U" & Satır), "*TOPLAMı") >= 1 Then
                Cells(Satır, Sutun).Interior.ColorIndex = 35
                Cells(Satır, Sutun).Font.ColorIndex = 1
                Cells(Satır, Sutun).Font.Bold = True
            End If
        Next Sutun
    Next Satır
End Sub
 
M

muhasebeciyiz

Altın Üye
Katılım
10 Şubat 2006
Mesajlar
559
Excel Vers. ve Dili
Office 2016
64 Bit
Altın Üyelik Bitiş Tarihi
21-12-2027
Kod: 
Sub Biçimlendir()
    Dim Satır As Integer
    Dim Sutun As Integer
    Dim SonSatır As Integer
    Dim SonSutun As Integer
    Dim ws As Worksheet
    
    SonSatır = 350
    SonSutun = 21
    
    For Each ws In Worksheets
        For Satır = 9 To SonSatır
            For Sutun = 1 To SonSutun
                If Application.WorksheetFunction.CountIf(ws.Range("A" & Satır & ":U" & Satır), "*TOPLAM") >= 1 Then
                    ws.Cells(Satır, Sutun).Interior.ColorIndex = 9
                    ws.Cells(Satır, Sutun).Font.ColorIndex = 2
                    ws.Cells(Satır, Sutun).Font.Bold = True
                End If
                
                If Application.WorksheetFunction.CountIf(ws.Range("A" & Satır & ":U" & Satır), "*TOPLAMı") >= 1 Then
                    ws.Cells(Satır, Sutun).Interior.ColorIndex = 35
                    ws.Cells(Satır, Sutun).Font.ColorIndex = 1
                    ws.Cells(Satır, Sutun).Font.Bold = True
                End If
            Next Sutun
        Next Satır
    Next ws
End Sub
deneyiniz
 
M

muhasebeciyiz

Altın Üye
Katılım
10 Şubat 2006
Mesajlar
559
Excel Vers. ve Dili
Office 2016
64 Bit
Altın Üyelik Bitiş Tarihi
21-12-2027
Kod: 
Sub Biçimlendir()
    Dim Satır As Integer
    Dim Sutun As Integer
    Dim SonSatır As Integer
    Dim SonSutun As Integer
    Dim ws As Worksheet
    Dim Aranan As Range
    Dim TOPLAM_Sayısı As Long
    Dim TOPLAMı_Sayısı As Long
    
    SonSatır = 350
    SonSutun = 21
    
    
    For Each ws In Worksheets
        For Satır = 9 To SonSatır
            Set Aranan = ws.Range("A" & Satır & ":U" & Satır)
            TOPLAM_Sayısı = Application.WorksheetFunction.CountIf(Aranan, "*TOPLAM")
            TOPLAMı_Sayısı = Application.WorksheetFunction.CountIf(Aranan, "*TOPLAMı")
            
            
            If TOPLAM_Sayısı >= 1 Then
                For Sutun = 1 To SonSutun
                    If ws.Cells(Satır, Sutun).Value Like "*TOPLAM*" Then
                        ws.Cells(Satır, Sutun).Interior.ColorIndex = 9
                        ws.Cells(Satır, Sutun).Font.ColorIndex = 2
                        ws.Cells(Satır, Sutun).Font.Bold = True
                    End If
                Next Sutun
            End If
            
          
            If TOPLAMı_Sayısı >= 1 Then
                For Sutun = 1 To SonSutun
                    If ws.Cells(Satır, Sutun).Value Like "*TOPLAMı*" Then
                        ws.Cells(Satır, Sutun).Interior.ColorIndex = 35
                        ws.Cells(Satır, Sutun).Font.ColorIndex = 1
                        ws.Cells(Satır, Sutun).Font.Bold = True
                    End If
                Next Sutun
            End If
        Next Satır
    Next ws
End Sub
Bu kod, her satır için CountIf fonksiyonunu yalnızca bir kez çağırır ve daha sonra bu sayılar üzerinde koşullu biçimlendirme yapar. Bu, kodun daha hızlı çalışmasını sağlar çünkü aynı arama işlemleri tekrarlanmaz.Deneyiniz
 
M

muhasebeciyiz

Altın Üye
Katılım
10 Şubat 2006
Mesajlar
559
Excel Vers. ve Dili
Office 2016
64 Bit
Altın Üyelik Bitiş Tarihi
21-12-2027
Kod: 
Sub Biçimlendir()
    Dim Satır As Integer
    Dim SonSatır As Integer
    Dim ws As Worksheet
    Dim Aralık As Range
    Dim Sonuç As Variant
   
    SonSatır = 350
 
    For Each ws In Worksheets
        Set Aralık = ws.Range("A9:U" & SonSatır)
       
        Sonuç = Aralık.FormulaArray
       
        Aralık.Replace "*TOPLAM*", "*TOPLAM*", xlPart, , False, , , False
        Aralık.Replace "*TOPLAM*", "*TOPLAM*", xlPart, , False, , , False
        Aralık.Replace "*TOPLAM*", "*TOPLAM*", xlPart, , False, , , False
        Aralık.Replace "*TOPLAM*", "*TOPLAM*", xlPart, , False, , , False      
       
        Aralık.Replace "*TOPLAMı*", "*TOPLAMı*", xlPart, , False, , , False
        Aralık.Replace "*TOPLAMı*", "*TOPLAMı*", xlPart, , False, , , False
        Aralık.Replace "*TOPLAMı*", "*TOPLAMı*", xlPart, , False, , , False
        Aralık.Replace "*TOPLAMı*", "*TOPLAMı*", xlPart, , False, , , False      
       
        With Aralık.Font
            .Bold = False
            .ColorIndex = xlAutomatic
        End With
        With Aralık.Interior
            .ColorIndex = xlNone
        End With
        With Aralık.FormatConditions
            .Delete
        End With
        With Aralık.FormatConditions
            .Delete
        End With
    Next ws
End Sub



Hızlı Bulmaya alternatif.
 
E

euphrates55

Katılım
25 Ocak 2006
Mesajlar
763
Excel Vers. ve Dili
2019 tr
Altın Üyelik Bitiş Tarihi
04-01-2024
muhasebeciyiz' Alıntı:
Kod: 
Sub Biçimlendir()
    Dim Satır As Integer
    Dim Sutun As Integer
    Dim SonSatır As Integer
    Dim SonSutun As Integer
    Dim ws As Worksheet
    Dim Aranan As Range
    Dim TOPLAM_Sayısı As Long
    Dim TOPLAMı_Sayısı As Long

    SonSatır = 350
    SonSutun = 21


    For Each ws In Worksheets
        For Satır = 9 To SonSatır
            Set Aranan = ws.Range("A" & Satır & ":U" & Satır)
            TOPLAM_Sayısı = Application.WorksheetFunction.CountIf(Aranan, "*TOPLAM")
            TOPLAMı_Sayısı = Application.WorksheetFunction.CountIf(Aranan, "*TOPLAMı")
        
        
            If TOPLAM_Sayısı >= 1 Then
                For Sutun = 1 To SonSutun
                    If ws.Cells(Satır, Sutun).Value Like "*TOPLAM*" Then
                        ws.Cells(Satır, Sutun).Interior.ColorIndex = 9
                        ws.Cells(Satır, Sutun).Font.ColorIndex = 2
                        ws.Cells(Satır, Sutun).Font.Bold = True
                    End If
                Next Sutun
            End If
        
      
            If TOPLAMı_Sayısı >= 1 Then
                For Sutun = 1 To SonSutun
                    If ws.Cells(Satır, Sutun).Value Like "*TOPLAMı*" Then
                        ws.Cells(Satır, Sutun).Interior.ColorIndex = 35
                        ws.Cells(Satır, Sutun).Font.ColorIndex = 1
                        ws.Cells(Satır, Sutun).Font.Bold = True
                    End If
                Next Sutun
            End If
        Next Satır
    Next ws
End Sub
Bu kod, her satır için CountIf fonksiyonunu yalnızca bir kez çağırır ve daha sonra bu sayılar üzerinde koşullu biçimlendirme yapar. Bu, kodun daha hızlı çalışmasını sağlar çünkü aynı arama işlemleri tekrarlanmaz.Deneyiniz
Genişletmek için tıkla ...
merhaba, öncelikle teşekkürler.
kodda toplam olayları karışıyor sanırım, o kısmı aşağıda göreceğiniz şekilde çözdüm. ((Aranan, "TOPLAM") ve (Aranan, "*YILI TOPLAMI") yaptım) fakat sadece toplam ya da yılı toplamı yazan hücreleri boyuyor. oysaki U sütununa kadar tüm satırı boyamalı. onu da çözersek benim işim tamam olacaktır.

şimdi bakınca anladım, her hücrede toplam toplamı yazmadığı için sadece o hücre biçimlendiriliyor. oysa ki toplam ya da toplamı yazısını bulduğunda tüm satırı biçimlendirmeli

alttaki son kodunuzda işler karışıyor isimleri değiştiriyor vs. buradan devam edebilirseniz çok sevinirim.

son durum kodum şu şekilde
Kod: 
Sub Biçimlendir()
    Dim Satır As Integer
    Dim Sutun As Integer
    Dim SonSatır As Integer
    Dim SonSutun As Integer
    Dim ws As Worksheet
    Dim Aranan As Range
    Dim TOPLAM_Sayısı As Long
    Dim TOPLAMı_Sayısı As Long
   
    SonSatır = 350
    SonSutun = 21
   
   
    For Each ws In Worksheets
        For Satır = 9 To SonSatır
            Set Aranan = ws.Range("A" & Satır & ":U" & Satır)
            TOPLAM_Sayısı = Application.WorksheetFunction.CountIf(Aranan, "TOPLAM")
            TOPLAMı_Sayısı = Application.WorksheetFunction.CountIf(Aranan, "*YILI TOPLAMI")
           
           
            If TOPLAM_Sayısı >= 1 Then
                For Sutun = 1 To SonSutun
                    If ws.Cells(Satır, Sutun).Value Like "TOPLAM" Then
                        ws.Cells(Satır, Sutun).Interior.ColorIndex = 9
                        ws.Cells(Satır, Sutun).Font.ColorIndex = 2
                        ws.Cells(Satır, Sutun).Font.Bold = True
                    End If
                Next Sutun
            End If
           
         
            If TOPLAMı_Sayısı >= 1 Then
                For Sutun = 1 To SonSutun
                    If ws.Cells(Satır, Sutun).Value Like "*YILI TOPLAMI*" Then
                        ws.Cells(Satır, Sutun).Interior.ColorIndex = 35
                        ws.Cells(Satır, Sutun).Font.ColorIndex = 1
                        ws.Cells(Satır, Sutun).Font.Bold = True
                    End If
                Next Sutun
            End If
        Next Satır
    Next ws
End Sub
 
Son düzenleme:
M

muhasebeciyiz

Altın Üye
Katılım
10 Şubat 2006
Mesajlar
559
Excel Vers. ve Dili
Office 2016
64 Bit
Altın Üyelik Bitiş Tarihi
21-12-2027
Kod: 
Sub Biçimlendir()
    Dim Satır As Integer
    Dim SonSatır As Integer
    Dim SonSutun As Integer
    Dim ws As Worksheet
    Dim Aranan As Range
    Dim TOPLAM_Sayısı As Long
    Dim TOPLAMı_Sayısı As Long
    
    SonSatır = 350
    SonSutun = 21
    
    For Each ws In ThisWorkbook.Worksheets
        Set Aranan = ws.Range("A9:U" & SonSatır)
        
        For Satır = 9 To SonSatır
            TOPLAM_Sayısı = Application.WorksheetFunction.CountIf(Aranan.Rows(Satır - 8), "TOPLAM")
            TOPLAMı_Sayısı = Application.WorksheetFunction.CountIf(Aranan.Rows(Satır - 8), "*TOPLAMı*")
            
            If TOPLAM_Sayısı >= 1 Then
                Aranan.Rows(Satır - 8).Interior.ColorIndex = 9
                Aranan.Rows(Satır - 8).Font.ColorIndex = 2
                Aranan.Rows(Satır - 8).Font.Bold = True
            End If
            
            If TOPLAMı_Sayısı >= 1 Then
                Aranan.Rows(Satır - 8).Interior.ColorIndex = 35
                Aranan.Rows(Satır - 8).Font.ColorIndex = 1
                Aranan.Rows(Satır - 8).Font.Bold = True
            End If
        Next Satır
    Next ws
End Sub
 
E

euphrates55

Katılım
25 Ocak 2006
Mesajlar
763
Excel Vers. ve Dili
2019 tr
Altın Üyelik Bitiş Tarihi
04-01-2024
muhasebeciyiz' Alıntı:
Kod: 
Sub Biçimlendir()
    Dim Satır As Integer
    Dim SonSatır As Integer
    Dim SonSutun As Integer
    Dim ws As Worksheet
    Dim Aranan As Range
    Dim TOPLAM_Sayısı As Long
    Dim TOPLAMı_Sayısı As Long
   
    SonSatır = 350
    SonSutun = 21
   
    For Each ws In ThisWorkbook.Worksheets
        Set Aranan = ws.Range("A9:U" & SonSatır)
       
        For Satır = 9 To SonSatır
            TOPLAM_Sayısı = Application.WorksheetFunction.CountIf(Aranan.Rows(Satır - 8), "TOPLAM")
            TOPLAMı_Sayısı = Application.WorksheetFunction.CountIf(Aranan.Rows(Satır - 8), "*TOPLAMı*")
           
            If TOPLAM_Sayısı >= 1 Then
                Aranan.Rows(Satır - 8).Interior.ColorIndex = 9
                Aranan.Rows(Satır - 8).Font.ColorIndex = 2
                Aranan.Rows(Satır - 8).Font.Bold = True
            End If
           
            If TOPLAMı_Sayısı >= 1 Then
                Aranan.Rows(Satır - 8).Interior.ColorIndex = 35
                Aranan.Rows(Satır - 8).Font.ColorIndex = 1
                Aranan.Rows(Satır - 8).Font.Bold = True
            End If
        Next Satır
    Next ws
End Sub
Genişletmek için tıkla ...
nokta koyuldu, teşekkürler.
 
Muzaffer Ali

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
Merhaba.
Alternatif kod.
("Sayfa1", "Sayfa2", "Sayfa3") kısmına koşullu biçimlendirme yapılacak kendi dosyanızdaki sayfa adlarını yazınız.
Test adlı kodu çalıştırınız.
Adını yazdığınız sayfalara koşullu biçimlendirme eklenecektir.

Kod: 
Sub Test()
    Dim syf() As Variant
    Dim Bak As Integer
    syf = Array("Sayfa1", "Sayfa2", "Sayfa3")
  
    For Bak = 0 To UBound(syf)
        KosulluBicimlendir Worksheets(syf(Bak))
    Next
End Sub
Sub KosulluBicimlendir(Sayfa As Worksheet)

    With Sayfa.Range("$A$9:$U$350")
        .FormatConditions.Add Type:=xlExpression, Formula1:="=EĞER((EĞERSAY($A9;""*TOPLAM""))>=1;1)"
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        .FormatConditions(1).StopIfTrue = False
        .FormatConditions(1).Font.Bold = True
        .FormatConditions(1).Font.Color = 2
        With .FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 9
            .TintAndShade = 0
        End With
      
      
        .FormatConditions.Add Type:=xlExpression, Formula1:="=EĞER((EĞERSAY($A9;""*TOPLAMI""))>=1;1)"
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        .FormatConditions(1).StopIfTrue = False
        .FormatConditions(1).Font.Bold = True
        .FormatConditions(1).Font.Color = 1
        With .FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 35
            .TintAndShade = 0
        End With
    End With
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst