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

 

[modoste]

kodu çalıştıra bastığımda böyle bir ekran çıkıyo ne yapmalıyım
bir önceki kodu denediğimde bu olmamıştı. End If, Next, End Sub ile ilgili birşey mi anlayamadım

 

[Muzaffer Ali]

Kodlar otomatik çalışacak şekilde olmasını istemiştiniz. "ES18:US42" aralığında bir değişiklik yapın kodlar çalışır.

 

[modoste]

dediğinizi anladım sayın hocam, kodlar otomatik çalışması ile ilgili son isteğim olmuştu
12. mesajda gönderdiğiniz kodu yeni kodu ekledim makroyu çalıştır dediğimde 13. mesajımdaki Macros penceresi neden açıldı anlayamadım

 

[Muzaffer Ali]

Private Sub Worksheet_Change(ByVal Target As Range) gibi otomatik çalışan bir kodu F5'e yada Çalıştır butonuna basarak çalıştıramazsınız.

 

[modoste]

bir önceki konudan vazgeçip hocam başka birşey sormak istiyorum (genel makro bilgim olmadığından birşey yapamadım)
sayfa1,sayfa2,sayfa3 3 adet sayfam var
sayfa1 de 10 nolu mesajdaki kodu yaptım ve kullanılmakta
safya 2 de yine 10 nolu kodda aralığı bu sefer ES18S42 değilde DI18:KG42 olarak girmek istiyorum
sayfa 3 de de ES52Z150 aralıklarını girmek istiyorum

3 sekme ve herbirinde farklı 3 kod yazılcak hangi sekmede çalışıyosam onun makrosu çalışcak
nasıl yapabiliriz.

 

[Muzaffer Ali]

Otomatik mi çalışmasını istiyorsunuz (yani hücrede bir değişiklik yaptığınızda kodlar otomatik çalışsın) yoksa butona basarak mı çalıştırmak istiyorsunuz?

 

[modoste]

butona basarak olsun sayın hocam

 

[Muzaffer Ali]

10. mesajdaki kodu her sayfanın kendi kod sayfasına kopyalayın.
Kodlar karışmaması için başlıklarını değiştirin Örnek Test1, Test2, Test3 gibi
Kodda bulunan şu satırı her sayfanın kendi aralığına göre değiştirin Set Alan = Range("ES18:US42")