Bir listedeki satırları gri veya beyaz renge boyatma

burakturk

Altın Üye
Katılım
12 Şubat 2013
Mesajlar
41
Excel Vers. ve Dili
Türkçe Excel 2019
Merhaba arkadaşlar,
Çok ilginç bir soru ile buradayım, bir çok soruma buradan cevap bulabildim ancak bu sorumun cevabını hiç bir yerde bulamadım. Belki biraz uzun olacak ama iyi anlatmam gerekiyor.

SQL Üzerinden otomatik çektiğim lastik stok listeleri mevcut, yeni stok gelebiliyor veya stok kullanım dışı olabiliyor.

Örnek veriyorum 11 R 22.5 ebatında 10 farklı stok, 12 R 22.5 ebatında 8 farklı stok 295/80 R 22.5 ebatında 5 farklı stok oluyor ve hemen hemen 50 tane kadar farklı ebat mevcut. Tüm stokları tek bir listede getirmem gerekiyor.

Şu an yaptığım her çalışırken çektiğim listemde bu gruplar birbirine karışmasın diye her lastik ebatını ayrı ayrı renklendiriyorum (mesela 10 satır 11R22.5 dolgusuz oluyor sırada 12R22.5 var ise bunu açık gri renge boyuyorum)

ancak her listeyi yenilediğimde bu renklendirme kaydığı için tekrar bunu yapmak zorunda kalıyorum ve bazen saatlerimi alabiliyor.

bu işlemi makro veya farklı bir şekilde daha kolay yapabilme imkanım var mıdır?

Uzman arkadaşlar yardımcı olabilecektir diye düşünüyorum.

Teşekkür ederim
 

burakturk

Altın Üye
Katılım
12 Şubat 2013
Mesajlar
41
Excel Vers. ve Dili
Türkçe Excel 2019
Bu dosyayı inceleyin.Bazı düzenlemeler yaptım.Anladığım kadarı ile yapmaya çalıştım.

Alakanız ve dosya için teşekkürler, farklı bir şeyle alakalı çok işimi görecek bu dosya da ancak aradığım bu değil.

Baktığımda tek tek kodların içine lastik ebatlarını yazmışsınız, öncelikle onu yapmam mümkün değil sadece kamyon lastikleri için 50 civarı, binek lastikleri için 200 300 civarı ebat mevcut

İkinci olarak ise ben sadece gri veya beyaz çevirsin istiyorum.

renklendirme biçimi doğru ancak bir grubu beyaz bir grubu gri yapması lazım ve bunları ben gidip tanımlama yapmadan yaptırmalıyım.
 
Katılım
13 Kasım 2008
Mesajlar
326
Excel Vers. ve Dili
Microsoft Office Professional Plus 2010 TR
Örnek bir dosya ekleyin.Konuyu herkes inceleyebilir.Olması gerekeni belge içinde örneklendirin.Rahat bir çözüm bulunabilir böylelikle
 

burakturk

Altın Üye
Katılım
12 Şubat 2013
Mesajlar
41
Excel Vers. ve Dili
Türkçe Excel 2019
şu videodaki gibi renklendirmeyi otomatik yapmaya çalışıyorum. filtre yaptığım kısımları göstermiyor ama videonun sonundaki hale gelmesini istiyorum .

Veri Grubu Renklendirme
 
Katılım
13 Kasım 2008
Mesajlar
326
Excel Vers. ve Dili
Microsoft Office Professional Plus 2010 TR
Videoyu izlediğimde şöyle bir şey aklıma geldi. Aynı verileri renklendir gibi birşey diyebilir miyiz ?
Basit şekli ile.C sütunu Stok isimlerinin hepsinde uygulayacaktır. Bir deneyin.


Public Sub HLightRows()
Dim i As Integer
i = 2
Dim c As Integer
c = 6

Do While (Cells(i, 3) <> "")
If (Cells(i, 3) <> Cells(i - 1, 3)) Then '
If c = 2 Then
c = 15 'color 2
Else
c = 2 'color 1
End If
End If

Rows(Trim(Str(i)) + ":" + Trim(Str(i))).Interior.ColorIndex = c
i = i + 1
Loop
End Sub
 

burakturk

Altın Üye
Katılım
12 Şubat 2013
Mesajlar
41
Excel Vers. ve Dili
Türkçe Excel 2019
Videoyu izlediğimde şöyle bir şey aklıma geldi. Aynı verileri renklendir gibi birşey diyebilir miyiz ?
Basit şekli ile.C sütunu Stok isimlerinin hepsinde uygulayacaktır. Bir deneyin.


Public Sub HLightRows()
Dim i As Integer
i = 2
Dim c As Integer
c = 6

Do While (Cells(i, 3) <> "")
If (Cells(i, 3) <> Cells(i - 1, 3)) Then '
If c = 2 Then
c = 15 'color 2
Else
c = 2 'color 1
End If
End If

Rows(Trim(Str(i)) + ":" + Trim(Str(i))).Interior.ColorIndex = c
i = i + 1
Loop
End Sub
Malesef tam olarak bu değil,
buradaki şart C sütununda bulunan stok isimlerinin ilk 11 karakterine göre (lastik ebatlarına göre) renklendirme yapması.
Yane 10 R 22.5 ile başlayanlar dolgusuz
11 R 22.5 ile başlayanlar gri
12 R 22.5 ebatına geçtiğinde yine dolgusuz
13 R 22.5 ebatına geçince tekrar gri olacak şekilde liste sonuna kadar tekrar etmesi
 

Korhan Ayhan

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
28,439
Excel Vers. ve Dili
OFFICE 2019 PRO TR
Örnek dosya paylaşabilir misiniz?
 

burakturk

Altın Üye
Katılım
12 Şubat 2013
Mesajlar
41
Excel Vers. ve Dili
Türkçe Excel 2019
Örnek dosya paylaşabilir misiniz?
Geç cevabım için kusura bakmayın, altın üye olmadığım için buraya yükleyemedim ancak aşağıdaki linkten indirebilirsiniz.

Not: Forum kurallarında dosya paylaşımı ile alakalı bir şey görmedim, umarım kurallara aykırı değildir.

 

Korhan Ayhan

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
28,439
Excel Vers. ve Dili
OFFICE 2019 PRO TR
Deneyiniz.

C++:
Option Explicit

Sub Renklendir()
    Dim X As Long, Son As Long, Renk As Integer
    Dim Veri As Variant, Zaman As Double
   
    Zaman = Timer
   
    Renk = 15
   
    Range("A3:D" & Rows.Count).Interior.ColorIndex = xlNone
   
    Son = Cells(Rows.Count, "A").End(3).Row
   
    Veri = Range("D3:D" & Son).Value2
   
    For X = LBound(Veri) To UBound(Veri)
        If X = 1 Then
            Range("A" & X + 2 & ":D" & X + 2).Interior.ColorIndex = Renk
        ElseIf Cells(X + 2, "D") = Cells(X + 2 - 1, "D") Then
            Range("A" & X + 2 & ":D" & X + 2).Interior.ColorIndex = Cells(X + 2 - 1, "A").Interior.ColorIndex
        Else
            If Renk = 15 Then
                Renk = xlNone
            Else
                Renk = 15
            End If
            Range("A" & X + 2 & ":D" & X + 2).Interior.ColorIndex = Renk
        End If
    Next
   
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub
 

burakturk

Altın Üye
Katılım
12 Şubat 2013
Mesajlar
41
Excel Vers. ve Dili
Türkçe Excel 2019
Deneyiniz.

C++:
Option Explicit

Sub Renklendir()
    Dim X As Long, Son As Long, Renk As Integer
    Dim Veri As Variant, Zaman As Double
 
    Zaman = Timer
 
    Renk = 15
 
    Range("A3:D" & Rows.Count).Interior.ColorIndex = xlNone
 
    Son = Cells(Rows.Count, "A").End(3).Row
 
    Veri = Range("D3:D" & Son).Value2
 
    For X = LBound(Veri) To UBound(Veri)
        If X = 1 Then
            Range("A" & X + 2 & ":D" & X + 2).Interior.ColorIndex = Renk
        ElseIf Cells(X + 2, "D") = Cells(X + 2 - 1, "D") Then
            Range("A" & X + 2 & ":D" & X + 2).Interior.ColorIndex = Cells(X + 2 - 1, "A").Interior.ColorIndex
        Else
            If Renk = 15 Then
                Renk = xlNone
            Else
                Renk = 15
            End If
            Range("A" & X + 2 & ":D" & X + 2).Interior.ColorIndex = Renk
        End If
    Next
 
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub
tam olarak istediğim şey. ne kadar dua etsem azdır size. ellerinize sağlık

vaktiniz var ise bana mantığını açıklamanız mümkün mü?
 

Korhan Ayhan

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
28,439
Excel Vers. ve Dili
OFFICE 2019 PRO TR
Güle güle kullanın..

Kod içindeki 15 değeri gri rengin kodudur.

Döngü ilk başladığında ilk grup gri renk olmaktadır.

Sonrasındaki gruplar ise her seferinde bir üstteki satıra bakarak (D sütununda) değer aynı ise gri rengi vermeye devam etmektedir. Eğer değerler aynı değilse Renk değişkeni dolgusuz olarak ayarlanıyor ve değişik olan ilk satır dolgusuz olarak ayarlanıyor.

Döngü bu şekilde tüm satırlar bitene kadar devam ediyor.
 

burakturk

Altın Üye
Katılım
12 Şubat 2013
Mesajlar
41
Excel Vers. ve Dili
Türkçe Excel 2019
Güle güle kullanın..

Kod içindeki 15 değeri gri rengin kodudur.

Döngü ilk başladığında ilk grup gri renk olmaktadır.

Sonrasındaki gruplar ise her seferinde bir üstteki satıra bakarak (D sütununda) değer aynı ise gri rengi vermeye devam etmektedir. Eğer değerler aynı değilse Renk değişkeni dolgusuz olarak ayarlanıyor ve değişik olan ilk satır dolgusuz olarak ayarlanıyor.

Döngü bu şekilde tüm satırlar bitene kadar devam ediyor.
Çok teşekkür ederim.

D sütunu C sütunu içerisindeki verilerin ilk 12 harfini getiriyor, eğer öyle bir imkan var ise kodun neresini ne ile değiştirmem gerekir?
 

Korhan Ayhan

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
28,439
Excel Vers. ve Dili
OFFICE 2019 PRO TR
D sütununu kaldırmak mı istiyorsunuz?
 

burakturk

Altın Üye
Katılım
12 Şubat 2013
Mesajlar
41
Excel Vers. ve Dili
Türkçe Excel 2019
D sütununu kaldırmak mı istiyorsunuz?
Şöyle anlatayım;

SQL'de tasarlanan tabloldan gelen veri A ile V sütunları arasında oluyor, ben kendim renklendirme yapmak için ayrıca bir Y sütunu ekliyorum (sizin baz alarak renklendirme yaptığınız sütun)

Y sütunu içeriği C sütununun ("AÇIKLAMA" başıklı sütun) satırlarındaki ilk 12 karakterini SOLDAN(C1;12) formülü ile getiriyor.

Renklendirme kontrolü yaptığı (sizde D sütunu) sütunu eğer C sütunun ilk 11 veya 12 harfi olarak değiştirebiliyorsak ayrıca bir sütun daha açmak zorunda kalmayacağım
 

Korhan Ayhan

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
28,439
Excel Vers. ve Dili
OFFICE 2019 PRO TR
Deneyiniz.

C sütunundaki stok adının ilk 11 karakterine bakarak işlem yapar.

C++:
Option Explicit

Sub Renklendir()
    Dim X As Long, Son As Long, Renk As Integer
    Dim Veri As Variant, Zaman As Double
    
    Zaman = Timer
    
    Renk = 15
    
    Range("A3:V" & Rows.Count).Interior.ColorIndex = xlNone
    
    Son = Cells(Rows.Count, "A").End(3).Row
    
    Veri = Range("C3:C" & Son).Value2
    
    For X = LBound(Veri) To UBound(Veri)
        If X = 1 Then
            Range("A" & X + 2 & ":V" & X + 2).Interior.ColorIndex = Renk
        ElseIf Left(Cells(X + 2, "C"), 11) = Left(Cells(X + 2 - 1, "C"), 11) Then
            Range("A" & X + 2 & ":V" & X + 2).Interior.ColorIndex = Cells(X + 2 - 1, "A").Interior.ColorIndex
        Else
            If Renk = 15 Then
                Renk = xlNone
            Else
                Renk = 15
            End If
            Range("A" & X + 2 & ":V" & X + 2).Interior.ColorIndex = Renk
        End If
    Next
    
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub
 

burakturk

Altın Üye
Katılım
12 Şubat 2013
Mesajlar
41
Excel Vers. ve Dili
Türkçe Excel 2019
Deneyiniz.

C sütunundaki stok adının ilk 11 karakterine bakarak işlem yapar.

C++:
Option Explicit

Sub Renklendir()
    Dim X As Long, Son As Long, Renk As Integer
    Dim Veri As Variant, Zaman As Double
   
    Zaman = Timer
   
    Renk = 15
   
    Range("A3:V" & Rows.Count).Interior.ColorIndex = xlNone
   
    Son = Cells(Rows.Count, "A").End(3).Row
   
    Veri = Range("C3:C" & Son).Value2
   
    For X = LBound(Veri) To UBound(Veri)
        If X = 1 Then
            Range("A" & X + 2 & ":V" & X + 2).Interior.ColorIndex = Renk
        ElseIf Left(Cells(X + 2, "C"), 11) = Left(Cells(X + 2 - 1, "C"), 11) Then
            Range("A" & X + 2 & ":V" & X + 2).Interior.ColorIndex = Cells(X + 2 - 1, "A").Interior.ColorIndex
        Else
            If Renk = 15 Then
                Renk = xlNone
            Else
                Renk = 15
            End If
            Range("A" & X + 2 & ":V" & X + 2).Interior.ColorIndex = Renk
        End If
    Next
   
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub
Elleriniz dert görmesin. Mükemmel oldu. Çok sağolun
 

burakturk

Altın Üye
Katılım
12 Şubat 2013
Mesajlar
41
Excel Vers. ve Dili
Türkçe Excel 2019
peki bu özelliği tüm excel dosyalarında kullanmak için yapabileceğim bir şey var mı? Excel add on veya özelliği gibi
 

Korhan Ayhan

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
28,439
Excel Vers. ve Dili
OFFICE 2019 PRO TR
Eğer kullanacağınız dosyalar hep aynı yapıdaysa PERSONAL.XLSM dosyasına bu kodu kaydederek tüm dosyalarınızda kullanabilirsiniz.
 
Üst