Koşullu biçimlendirme

[modoste]

Merhaba sayın hocalarım
ekli dosyada sorumu ilettim

 

[ÖmerBey]

Merhaba,
Dosyanız eklediğiniz resimdeki gibi karışık bir yapıya sahipse kanaatimce makrolu çözüm daha uygun olacaktır.
Yine de denemek isteseniz aşağıdaki gibi bir çözüm önerebilirim.
C10'dan başlayan tablonuz için deneyiniz...

=VE(TEKMİ(EĞERSAY(KAYDIR($C10;0;0;-3);$C10));--SAĞDAN($C10;1)<>TOPLA(KAYDIR($C10;0;2;EĞER($C10=$C11;2;1))))

 

[modoste]

çözüm doğru ben mavi renle biçimlendirdim fakat A5 olan yerin altındaki A5 olan yerde renklense yada B4 lerin ilki renklendi ama altındaki de renklense

 

[Muzaffer Ali]

Merhaba.

Örnek dosyada C10:F17 aralığını seçip koşullu biçimlendirme formül kısmına aşağıdaki formülü kopyalayın.

=ÇOKEĞER($C10=$C9;SAYIYAÇEVİR( SAĞDAN($C10;1))<>$E9+$E10;$C10=$C11;SAYIYAÇEVİR( SAĞDAN($C10;1))<>$E11+$E10;$C10<>$C11;SAYIYAÇEVİR( SAĞDAN($C10;1))<>$E10)

 

[ÖmerBey]

Bu örnek için mümkün, ancak ilk mesajınızda paylaştığınız dosyada aynı kodlu veriler birden çok sayıda alt alta gelmiş. Örneğin L4 10 defa alt alta gelmiş. Bu şekilde problem çıkma ihtimali yüksektir.
Deneyiniz...

=YADA(VE(TEKMİ(EĞERSAY(KAYDIR($C10;0;0;-3);$C10));--SAĞDAN($C10;1)<>TOPLA(KAYDIR($C10;0;2;EĞER($C10=$C11;2;1))));VE(ÇİFTMİ(EĞERSAY(KAYDIR($C10;0;0;-3);$C10));--SAĞDAN($C10;1)<>TOPLA(KAYDIR($C10;0;2;-2))))

 

[modoste]

teşekkür ederim çözüm için

4 lü veriler böyle sağ doğru devam ediyo koşullu biçimlendirmeyi diğerleri içinde doğru çalışması için nasıl yapmalıyız
biz ilk 4 lü grup için koşul yaptık

 

[modoste]

6 nolu mesajımdaki gibidir dosyamın bütünü,
ben çözümlemeyi anlamak uygulamak adına basite indirgeyerek sordum ama en genel çözüm için 6 nolu mesajımdaki gibi düşünülmesi gerekiyo verilerin

 

[Muzaffer Ali]

Çözüm için hangi değerlerin(L4'lerin) birbiri ile grup olduğunu bilmek gerekiyor.
Formül ile biçimlendirmelerin durumu kontrol edilemediğinden kutuların-çizgilerin bir anlamı yok.

Kod ile yapılabilir isterseniz.
Olur derseniz üstte fotosunu paylaştığınız listeyi Excel ile paylaşınız

 

[modoste]

kod ile çözüm kullanabilirim
karelaj çok uzun zaten hatalı veri yazdım mı diye renklerin beni uyarması gerekiyor

bu gibi 5-6 farklı çalışma daha var
gelecek kod da diğerlerine göre dönüştürmeyi deneyeceğim

ekli dosyada her sırada benzersiz verilerle ilgili çözümlemelerde bulunmaktadır belki çözüme katkısı olur

 

[Muzaffer Ali]

Deneyin.
Tablonuz "ES18:US42" aralığında olduğu için bu alanı baz aldım.

Sub Test()
    Dim Alan As Range
    Dim Bak As Range
    Dim Renk As Long
    Renk = ColorConstants.vbGreen
    Set Alan = Range("ES18:US42")
    Alan.Interior.Pattern = xlNone
   
    For Each Bak In Alan
        If Not IsNumeric(Bak) Then
            If Bak.Borders(xlEdgeTop).LineStyle = 1 And Bak.Borders(xlEdgeBottom).LineStyle = 1 Then
                If IsNumeric(Right(Bak, 1)) Then
                    If Val(Right(Bak, 1)) <> Bak(1, 3) Then
                        Bak.Resize(1, 4).Interior.Color = Renk
                    End If
                Else
                    If Bak(1, 3) <> 0 Then
                        Bak.Resize(1, 4).Interior.Color = Renk
                    End If
                End If
            ElseIf Bak.Borders(xlEdgeTop).LineStyle = 1 And Bak(2, 1).Borders(xlEdgeBottom).LineStyle = 1 Then
                If Val(Right(Bak, 1)) <> (Bak(1, 3) + Bak(2, 3)) Then
                    Bak.Resize(2, 4).Interior.Color = Renk
                End If
            End If
        End If
    Next
End Sub

 

[modoste]

makro çalışınca hatalı verileri buldu
çözüm için teşekkürler
makrolu kaydettikten sonra herhangi bir veriyi değişip enter dediğimde otomatik renklenmiyo makroyu yeniden çalıştırınca renklenme oluyo

 

[Muzaffer Ali]

Sayfanın kod kısmına kopyalayın.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Alan As Range
    Dim Bak As Range
    Dim Renk As Long
    Set Alan = Range("ES18:US42")
    If Not Intersect(Alan, Target) Is Nothing Then
        Renk = ColorConstants.vbGreen
        Alan.Interior.Pattern = xlNone
        For Each Bak In Alan
            If Not IsNumeric(Bak) Then
                If Bak.Borders(xlEdgeTop).LineStyle = 1 And Bak.Borders(xlEdgeBottom).LineStyle = 1 Then
                    If IsNumeric(Right(Bak, 1)) Then
                        If Val(Right(Bak, 1)) <> Bak(1, 3) Then
                            Bak.Resize(1, 4).Interior.Color = Renk
                        End If
                    Else
                        If Bak(1, 3) <> 0 Then
                            Bak.Resize(1, 4).Interior.Color = Renk
                        End If
                    End If
                ElseIf Bak.Borders(xlEdgeTop).LineStyle = 1 And Bak(2, 1).Borders(xlEdgeBottom).LineStyle = 1 Then
                    If Val(Right(Bak, 1)) <> (Bak(1, 3) + Bak(2, 3)) Then
                        Bak.Resize(2, 4).Interior.Color = Renk
                    End If
                End If
            End If
        Next
    End If
End Sub