OTOMATIK RENKLENDİRME

[smt]

Merhabalar,

aşağıdaki örnek tablomda fatura numarasına göre hat bl beyanname no satırlarını sırayla sarı ve yeşil ile renklendirmek istiyorum ayrıca dekont numaralarının ilk satırını da sarıya boyamak istiyorum bu listeler binlerce satıra kadar uzuyor bunu otomatik olarak yapmam için yardımcı olabilir misiniz.

ÖRNEK LİSTE.xlsx - 10 KB

 

[muhasebeciyiz]

Sub BeyannameRenklendirme()

    Dim ws As Worksheet
    Dim lastRow As Long
    Dim cell As Range
    Dim faturaNo As String
    Dim renk As Long
    Dim renkDönüşümü As Boolean
    Dim faturaNumaraları As Object
   
    Set ws = ThisWorkbook.ActiveSheet
   
    lastRow = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row
   
    renkDönüşümü = True
   
    Set faturaNumaraları = CreateObject("Scripting.Dictionary")
   
    For Each cell In ws.Range("E2:E" & lastRow)
        faturaNo = cell.Value
       
        If Len(faturaNo) > 0 Then
            If Not faturaNumaraları.exists(faturaNo) Then
                If renkDönüşümü Then
                    renk = RGB(255, 255, 0)
                Else
                    renk = RGB(0, 255, 0)
                End If
               
                ws.Range("A" & cell.Row & ":E" & cell.Row).Interior.Color = renk
               
                faturaNumaraları.Add faturaNo, 1
               
                renkDönüşümü = Not renkDönüşümü
            Else
               
                ws.Range("A" & cell.Row & ":D" & cell.Row).Interior.Color = renk
            End If
        End If
    Next cell

End Sub

Bu kod, her yeni fatura numarası için E sütunundaki ilk hücreyi renklendirir ve ardından aynı fatura numarasına sahip diğer satırlar için A arasındaki hücreleri boyar. Bu şekilde renkler sırasıyla sarı ve yeşil olarak geçiş yapar. Umarım bu çözüm işinize yarar

 

[smt]

Sub BeyannameRenklendirme()

    Dim ws As Worksheet
    Dim lastRow As Long
    Dim cell As Range
    Dim beyannameNo As String
    Dim sarıEboyandı As Boolean
    Dim yeşilEboyandı As Boolean
   
    Set ws = ThisWorkbook.ActiveSheet
   
    lastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
   
    sarıEboyandı = False
    yeşilEboyandı = False

    For Each cell In ws.Range("D2:D" & lastRow)
        beyannameNo = cell.Value
       
        If Len(beyannameNo) > 0 Then
            Select Case UCase(Left(beyannameNo, 1))
                Case "B", "D", "F", "H", "J", "L", "N", "P", "R", "T", "V", "X", "Z"
                    cell.Offset(0, -3).Resize(1, 4).Interior.Color = RGB(255, 255, 0)
                   
                    If Not sarıEboyandı Then
                        cell.Offset(0, 1).Interior.Color = RGB(255, 255, 0)
                        sarıEboyandı = True
                        yeşilEboyandı = False
                    End If
                   
                Case "C", "E", "G", "I", "K", "M", "O", "Q", "S", "U", "W", "Y"
                    cell.Offset(0, -3).Resize(1, 4).Interior.Color = RGB(0, 255, 0)
                   
                    If Not yeşilEboyandı Then
                        cell.Offset(0, 1).Interior.Color = RGB(0, 255, 0)
                        yeşilEboyandı = True
                        sarıEboyandı = False
                    End If
                   
                Case Else
                    cell.Offset(0, -3).Resize(1, 4).Interior.ColorIndex = -4142
                    cell.Offset(0, 1).Interior.ColorIndex = -4142
                    sarıEboyandı = False
                    yeşilEboyandı = False
            End Select
        End If
    Next cell

End Sub

Bu kod, her renklendirme türü için sadece ilk satırın E sütunundaki hücreyi boyayacak ve ardından diğer satırlardaki hücreler renklendirmeye devam edilecektir. Umarım bu çözüm işinize yarar

Hocam öncelikle çok teşekkür ederim ,ancak verileri değiştirdiğimde kod çalışmadı örnek 2 listeyi ekliyorum müsait olunca bakarsanız çok sevinirim
ÖRNEK LİSTE-2.xlsx - 10 KB

 

[muhasebeciyiz]

Verilen kod örnek -1 listesine göre yapılmıştır.

İndir boyalı örnek xlsm

Dosyayı indir boyalı örnek xlsm

dosya.co

 

[smt]

Verilen kod örnek -1 listesine göre yapılmıştır.

İndir boyalı örnek xlsm

Dosyayı indir boyalı örnek xlsm

dosya.co

Hocam örnek 2 ye nasıl uyarlayabiliriz

 

[muhasebeciyiz]

verdiğin 1.örnekte kriter beyanname numarasına göre tanzim edilmiştir.
2.örnekte böyle bir kriter yokki bu çözüm uygulansın hangi krirete göre renklendirme yapsınki.

 

[smt]

verdiğin 1.örnekte kriter beyanname numarasına göre tanzim edilmiştir.
2.örnekte böyle bir kriter yokki bu çözüm uygulansın hangi krirete göre renklendirme yapsınki.

hocam aslında ben ilk mesajımda yazmıştım fatura numarasına göre renklendirme yapılması için kriter fatura numarasına göre olması gerekiyor aslında fatura numarası değiştikçe renk de değişmesi gerekiyor

 

[smt]

verdiğin 1.örnekte kriter beyanname numarasına göre tanzim edilmiştir.
2.örnekte böyle bir kriter yokki bu çözüm uygulansın hangi krirete göre renklendirme yapsınki.

ÖRNEK-2-RENKLENDİRİLMİŞ.xlsx - 10 KB

hocam renklendirilmiş halini ekledim tam olarak böyle olması gerekiyor müsait olunca bakar mısınız

 

[muhasebeciyiz]

2 nolu mesajı yeniledim deneyiniz

 

[smt]

2 nolu mesajı yeniledim deneyiniz

Hocam çok teşekkür ederim elinize emeğinize sağlık uğraştırdığım için kusura bakmayın.