hücrelerde renklendirme

[kemalist]

arkadaşlar merhaba benim yapmak istediğim D sütunundaki bir ismi E sütununda ile aynı isim olduğunda aynı rengi alması.
Örnek dosya ektedir.
İlginize şimdiden teşekkür ederim.

 

[savas_145]

Sütunların ayni satirlardaki isimlerin ayni olduğu zaman renklendirmesine istiyorsun galiba.
Verilerin D1:E100 arasında olduğunu varsayiyorum D1:E100 arasını seç. Giriş sekmesinde koşullu biçimlendirmeye gir. Yeni kosul de. Açılan sayfada formüllü koşul kısmını bul

$D1=$E1

Yaz. Bicim kısmından istediğin renklendirmeyi yap
Sadece d renklenicekse D1: D100 arasını seç. Yine ayni kodu kullan

 

[Emir Hüseyin Çoban]

. . .

E sütunu kendiliğinden renkli mi yoksa
eşletirmek yaptıktan sonra hemde D hem E sütununu mu renklendirecek.

. . .

 

[tascimehmet]

ekteki umarım işinize yarar sarıda görünmedigi için mavi yaptım.

iyi çalışmalar.

 

[kemalist]

. . .

E sütunu kendiliğinden renkli mi yoksa
eşletirmek yaptıktan sonra hemde D hem E sütununu mu renklendirecek.

. . .

E sütunu hazır yani renkli;sadece D sütunu renklendirilecek aynı isimler aynı renkte olacak.

 

[Emir Hüseyin Çoban]

E sütunu hazır yani renkli;sadece D sütunu renklendirilecek aynı isimler aynı renkte olacak.

. . .

Birde veri girişi yaptığınız andamı çalıştırmak istiyorsunuz yoksa
listeye verileri girdikten sonra butonla tüm listeyi mi kontrol edelim.

. . .

 

[kemalist]

ekteki umarım işinize yarar sarıda görünmedigi için mavi yaptım.

iyi çalışmalar.

Hücrelerin rengi yok

 

[kemalist]

. . .

Birde veri girişi yaptığınız andamı çalıştırmak istiyorsunuz yoksa
listeye verileri girdikten sonra butonla tüm listeyi mi kontrol edelim.

. . .

Butonla olması daha iyi olur.İlginize teşekkür ederim.

 

[Emir Hüseyin Çoban]

. . .

Sub kod()
    Application.ScreenUpdating = False
    Dim WF As WorksheetFunction: Set WF = Application.WorksheetFunction
    
    With Range("D:D").Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
    s = Cells(Rows.Count, "E").End(3).Row
    For i = 4 To Cells(Rows.Count, "D").End(3).Row
        If Cells(i, "D") <> "" Then
            If WF.CountIf(Range("E4:E" & s), Cells(i, "D")) = 0 Then
                Cells(i, "D").Interior.Color = 65535
            Else
                f = WF.Match(Cells(i, "D"), Range("E:E"), 0)
                Cells(f, "E").Copy
                Cells(i, "D").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
                Application.CutCopyMode = False
            End If
        End If
    Next i
    
    Application.ScreenUpdating = True
    MsgBox "B i t t i "
End Sub

. . .

 

[kemalist]

. . .

Sub kod()
    Application.ScreenUpdating = False
    Dim WF As WorksheetFunction: Set WF = Application.WorksheetFunction
    
    With Range("D:D").Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
    s = Cells(Rows.Count, "E").End(3).Row
    For i = 4 To Cells(Rows.Count, "D").End(3).Row
        If Cells(i, "D") <> "" Then
            If WF.CountIf(Range("E4:E" & s), Cells(i, "D")) = 0 Then
                Cells(i, "D").Interior.Color = 65535
            Else
                f = WF.Match(Cells(i, "D"), Range("E:E"), 0)
                Cells(f, "E").Copy
                Cells(i, "D").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
                Application.CutCopyMode = False
            End If
        End If
    Next i
    
    Application.ScreenUpdating = True
    MsgBox "B i t t i "
End Sub

. . .

Hüseyin Bey teşekkür ederim.Gerçi siz sormuştunuz E sütunundaki hücrelerde bulunan her isme farklı rengi el ile giriyorum.Otomatik olarak farklı renkler girilebilir mi?

 

[Emir Hüseyin Çoban]

Veriler maksimum kac satir olabilir.
Renk kolaji yaparak satir sayisina gore dagitilabilir.

.

 

[kemalist]

Veriler maksimum kac satir olabilir.
Renk kolaji yaparak satir sayisina gore dagitilabilir.

.

250 satır olacak

 

[Emir Hüseyin Çoban]

. . .

Örnek bir kodlama;

Sub kod()
    For i = 1 To 250
        Cells(i, "A").Interior.Color = i * 100000
        Cells(i, "B") = i * 100000[COLOR="DarkGreen"] ' renk kodu[/COLOR]
    Next i
End Sub

. . .

 

[kemalist]

. . .

Örnek bir kodlama;

Sub kod()
    For i = 1 To 250
        Cells(i, "A").Interior.Color = i * 100000
        Cells(i, "B") = i * 100000[COLOR="DarkGreen"] ' renk kodu[/COLOR]
    Next i
End Sub

. . .

Hüseyin Bey Merhaba ilk önce ilginizden dolayı teşekkür etmek isterim.E sütununda isimler bitene kadar renklendirme yapmak istersek kodda nasıl bi değişiklik yapılabilir.
Ben kod üzerinde acizane bi şeyler yapmaya çalıştım fakat hata veriyor.

 

[Ömer BARAN]

Merhaba Sayın kemalist.

Yanlış anlamadıysam; aşağıdaki kod'u kullanırsanız;
-- D sütunundaki dolu hücrelerden E sütununda olanlar,
E sütunundakiyle aynı yazı rengi ve zemin rengini alır
-- D sütunundaki veri E sütununda yoksa zemin rengi kaldırılır ve yazırengi siyah olur.
.

[FONT="Arial Narrow"]Sub RENK()
Range("D:D").Interior.Color = xlNone: Range("D:D").Font.Color = 1
    For satır = 4 To [D65536].End(3).Row
        If Cells(satır, 4) = "" Then GoTo 10
        hedefalan = "E4:E" & [E65536].End(3).Row
        If WorksheetFunction.CountIf(Range(hedefalan), Cells(satır, 4)) = 0 Then GoTo 10
        hedefsatır = WorksheetFunction.Match(Cells(satır, 4), Range(hedefalan), 0) + 3
        Cells(satır, 4).Interior.Color = Cells(hedefsatır, "E").Interior.Color
        Cells(satır, 4).Font.Color = Cells(hedefsatır, "E").Font.Color
10: Next
End Sub[/FONT]

 

[Emir Hüseyin Çoban]

. . .

E sütununu renklendirmek için şu şekilde kullanabilirsiniz.

Sub kod()
    For i = 4 To Cells(Rows.Count, "E").End(3).Row
        Cells(i, "E").Interior.Color = i * 100000
        'Cells(i, "B") = i * 100000 ' renk kodu
    Next i
End Sub

. . .

 

[kemalist]

Hüseyin Bey ve Ömer Bey her ikinizede ayrı ayrı teşekkür ederim.