Tekrarlanan verileri farklı renkte yapma

Katılım
9 Aralık 2009
Mesajlar
125
Beğeniler
4
Excel Vers. ve Dili
Office 2016 TR 64 Bit
#1
merhaba. normalde tekrarlanan verileri koşullu biçimlendirme ile yapılmakta gayet iyi bilmekteyim. Sizden ricam her tekrarlan veri farklı renkte olacak.

örnek
1. tekrarlanan sarı
2. tekrarlana mavi
.....

bu tarzda yapabilir miyiz.
 

dalgalikur

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
2,211
Beğeniler
264
Excel Vers. ve Dili
2013
#2
Merhaba.
Koşullu biçimlendirme ile yapılabilir.

Biçimlendirme yapılacak alanın A sütunu olduğunu var sayarsak, sadece A2 hücresini seçin.
Koşullu Biçimlendirme / Yeni kural seçin.
Birinci kural için formül kullan seçin aşağıdaki formülü formül kısmına kopyalayın.
Kod:
=EĞERSAY(A$1:A2;A2)=1
Daha sonra 1. tekrar için gerekli biçimlendirme ayarlarını seçin.

Yeni Kural daha ekleyin formül kısmına aşağıdaki formülü kopyalayın.
Kod:
=EĞERSAY(A$1:A2;A2)=2
Daha sonra 2. tekrar için gerekli biçimlendirme ayarlarını seçin.

Yeni Kural daha ekleyin formül kısmına aşağıdaki formülü kopyalayın.
Kod:
=EĞERSAY(A$1:A2;A2)=3
Daha sonra 3. tekrar için gerekli biçimlendirme ayarlarını seçin.

Bu şekilde kural ekleyerek devam edebilirsiniz.

Kural ekleme bittikten sonra A2 hücresini kopyalayın A sütununu seçip, özel yapıştır, biçimler i seçin.
Tamamı tıklatın.
 
Katılım
9 Aralık 2009
Mesajlar
125
Beğeniler
4
Excel Vers. ve Dili
Office 2016 TR 64 Bit
#3
ilgi
Merhaba.
Koşullu biçimlendirme ile yapılabilir.

Biçimlendirme yapılacak alanın A sütunu olduğunu var sayarsak, sadece A2 hücresini seçin.
Koşullu Biçimlendirme / Yeni kural seçin.
Birinci kural için formül kullan seçin aşağıdaki formülü formül kısmına kopyalayın.
Kod:
=EĞERSAY(A$1:A2;A2)=1
Daha sonra 1. tekrar için gerekli biçimlendirme ayarlarını seçin.

Yeni Kural daha ekleyin formül kısmına aşağıdaki formülü kopyalayın.
Kod:
=EĞERSAY(A$1:A2;A2)=2
Daha sonra 2. tekrar için gerekli biçimlendirme ayarlarını seçin.

Yeni Kural daha ekleyin formül kısmına aşağıdaki formülü kopyalayın.
Kod:
=EĞERSAY(A$1:A2;A2)=3
Daha sonra 3. tekrar için gerekli biçimlendirme ayarlarını seçin.

Bu şekilde kural ekleyerek devam edebilirsiniz.

Kural ekleme bittikten sonra A2 hücresini kopyalayın A sütununu seçip, özel yapıştır, biçimler i seçin.
Tamamı tıklatın.

ilginiz için teşekkür ederim ama bende tekrarlayanlar baya fazla
 

dalgalikur

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
2,211
Beğeniler
264
Excel Vers. ve Dili
2013
#4
İsterseniz aşağıdaki kodları bir butona ekleyerek çalıştırın.

Kod:
Sub TekrarlarıRenklendir()
    Dim Bak As Range
    Dim Renkler() As Variant
    Dim Say As Integer
    Renkler = Array(, rgbAliceBlue, rgbAntiqueWhite, rgbAqua, rgbAquamarine, rgbAzure, rgbBeige, rgbBeige, rgbBisque, rgbBlanchedAlmond, rgbBlueViolet, rgbBrown, rgbBurlyWood)
    For Each Bak In Range("A2:A" & Cells(Rows.Count, "A").End(3).Row)
        Say = WorksheetFunction.CountIf(Range("A2:" & Bak.Address), Bak.Text)
        Bak.Interior.Color = Renkler(Say)
    Next
End Sub
Yada isterseniz aşağıdaki kodları sayfanın kod kısmına yazın, hücrede her değişiklik olduğunda renklendirme yapsın
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    Dim Bak As Range
    Dim Renkler() As Variant
    Dim Say As Integer
    Renkler = Array(, rgbAliceBlue, rgbAntiqueWhite, rgbAqua, rgbAquamarine, rgbAzure, rgbBeige, rgbBeige, rgbBisque, rgbBlanchedAlmond, rgbBlueViolet, rgbBrown, rgbBurlyWood)
    For Each Bak In Range(Target.Address & ":A" & Cells(Rows.Count, "A").End(3).Row)
        Say = WorksheetFunction.CountIf(Range("A1:" & Bak.Address), Bak.Text)
        Bak.Interior.Color = Renkler(Say)
    Next
End Sub
Ben 12 adet renk ekledim. Eğer daha fazla tekrarlama olursa hata verecektir.
Daha fazla tekrarlama olacaksa siz sadece en fazla tekrralanma sayısı kadar Renkler = Array(, rgbAliceBlue, rgbAntiqueWhite,... satırına yeni renkler ekleyin.
 
Katılım
9 Aralık 2009
Mesajlar
125
Beğeniler
4
Excel Vers. ve Dili
Office 2016 TR 64 Bit
#5
Emeğinize sağlık öncelikle. ben sorunu anlatamadım sanırım . tekrar eden urun grubları farklı renklerde olsun istiyorum misal kalem kalem kalem kırmızı silgi silgi mavi kağıt kağıt kağıt turuncu. grublar farklı renkler olup ayrımını anlamak için istemiştim
 

çıtır

Altın Üye
Altın Üye
Katılım
6 Mart 2005
Mesajlar
4,635
Beğeniler
741
Excel Vers. ve Dili
Excel Vers. ve Dili:
Office 2016 TR 64 Bit
#7
Koşul sayfasında ürün rengi belirleyiniz.Belirlediğiniz renk olsun.
 

Ekli dosyalar

Korhan Ayhan

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
24,639
Beğeniler
427
Excel Vers. ve Dili
OFFICE 2019 PRO TR
#8
Alternatif;

10.000 satır ve 1.000 farklı üründe aşağıdaki kodu denedim. 20-25 saniye civarında işlem sonuçlanıyor.

Kod:
Option Explicit

Sub Renklendir()
    Dim S1 As Worksheet, Dizi As Object, Urun As Variant, Say As Long
    Dim Son As Long, Veri As Variant, X As Long, Renkler As Object, Zaman As Double
    Dim Renk_Kodu_1 As Byte, Renk_Kodu_2 As Byte, Renk_Kodu_3 As Byte
   
    Zaman = Timer
   
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
   
    Set S1 = Sheets("Sheet1")
    Set Dizi = CreateObject("Scripting.Dictionary")
    Set Renkler = CreateObject("Scripting.Dictionary")
   
    On Error Resume Next
    S1.ShowAllData
    S1.Range("A2:A" & S1.Rows.Count).Interior.Color = xlNone
    On Error GoTo 0
   
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    Veri = S1.Range("A2:A" & Son).Value
   
    For X = 1 To UBound(Veri, 1)
        Dizi(Veri(X, 1)) = 1
    Next
   
    For Each Urun In Dizi.Keys
        S1.Range("A1").AutoFilter 1, Urun
Tekrar: Randomize
        Renk_Kodu_1 = Int((255 - 1 + 1) * Rnd + 1)
        Renk_Kodu_2 = Int((255 - 1 + 1) * Rnd + 1)
        Renk_Kodu_3 = Int((255 - 1 + 1) * Rnd + 1)
        If Not Renkler.Exists(RGB(Renk_Kodu_1, Renk_Kodu_2, Renk_Kodu_3)) Then
            Renkler.Add RGB(Renk_Kodu_1, Renk_Kodu_2, Renk_Kodu_3), Nothing
            S1.Range("A2:A" & Son).SpecialCells(xlCellTypeVisible).Interior.Color = RGB(Renk_Kodu_1, Renk_Kodu_2, Renk_Kodu_3)
        Else
            Say = Say + 1
            GoTo Tekrar
        End If
    Next

    On Error Resume Next
    S1.ShowAllData
    On Error GoTo 0
   
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
   
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "Mükerrer renk sayısı ; " & Say & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
 
Üst