A kolonu değerlerini diğer kolonlarda arayıp renklendirmek.

[dead cities]

Merhaba, A kolonundaki değerlerin herbiri, B kolonunun içinde var ise, A kolonundaki değer ile B kolonunda yer alan A kolonundaki değerin eşiti olan değer aynı renkte renkte olsun. örneğin A35 hücresindeki değer ile B67 hücresindeki değerin birbirinin aynı olduğunu düşünelim bu durumda, A35 ile B67 hücresi sarı olsun.
aynı mantıkla örneğin, A87 ile B132 değeri aynı ise, A87 ile B132 hücresi yeşil renk olsun.

Mümkün müdür, çok teşekküler

 

[İhsan Tank]

Merhaba, A kolonundaki değerlerin herbiri, B kolonunun içinde var ise, A kolonundaki değer ile B kolonunda yer alan A kolonundaki değerin eşiti olan değer aynı renkte renkte olsun. örneğin A35 hücresindeki değer ile B67 hücresindeki değerin birbirinin aynı olduğunu düşünelim bu durumda, A35 ile B67 hücresi sarı olsun.
aynı mantıkla örneğin, A87 ile B132 değeri aynı ise, A87 ile B132 hücresi yeşil renk olsun.

Mümkün müdür, çok teşekküler

merhaba
B sütununu seçin
Koşullu biçimlendirme - yeni kural - biçimlendirilecek hücreleri belirlemek için formül kullan - kutucuğa

=EĞERSAY($A:$A;$B1)>0

biçim'i ayarlayın
A sütununu seçin
koşullu biçimlendirme - yeni kural - biçimlendirilecek hücreleri belirlemek için formül kullan - kutucuğa

=EĞERSAY($B:$BA;$A1)>0

biçim'i ayarlayın.
kod ile isterseniz boş bir module kopyalayın ve deneyin

Option Explicit
Sub boya()
Dim ts, kaplan
kaplan = MsgBox("Aynı Olanları Boyuyorum", vbYesNo, "Onay")
If kaplan = vbNo Then Exit Sub
Application.DisplayAlerts = False
For ts = 3 To Cells(65536, "B").End(xlUp).Row
If WorksheetFunction.CountIf(Range("A3:A65536"), Cells(ts, "B")) > 0 Then
Cells(ts, "B").Interior.ColorIndex = 4
End If
Next
For ts = 3 To Cells(65536, "A").End(xlUp).Row
If WorksheetFunction.CountIf(Range("B3:B65536"), Cells(ts, "A")) > 0 Then
Cells(ts, "A").Interior.ColorIndex = 4
End If
Next
Application.DisplayAlerts = True
MsgBox "Eşit Olanları Boyadım", vbInformation, "Bitiş"
End Sub

 

[dead cities]

Öncelikle ilginize çok teşekkür ederim, ancak benim rica ettiğim, ekteki gibi bir sonuç verecek çalışma. yani, a kolonundaki değer b kolonunda var ise ikisi de aynı hücre rengine boyansın. tekrar teşekkürler..

 

[İhsan Tank]

Öncelikle ilginize çok teşekkür ederim, ancak benim rica ettiğim, ekteki gibi bir sonuç verecek çalışma. yani, a kolonundaki değer b kolonunda var ise ikisi de aynı hücre rengine boyansın. tekrar teşekkürler..

siz tek renk olsun istemediniz mi_?
her eşit olan'a ayrı ayrı mı renk verilecek yani bunu mu anlamalıyım.

 

[dead cities]

evet lütfen..

 

[dead cities]

yani her iki kolondaki iki eşit değer aynı renkte olacak..

 

[İhsan Tank]

yani her iki kolondaki iki eşit değer aynı renkte olacak..

merhaba
boş bir module kopyalayın ve deneyin.
Not : Excel'deki renk sayısı kadar renklendirir sonra hata verir bilginiz olsun.
yani 56 adet renk tanımlar

Option Explicit
Sub boya()
On Error Resume Next
Dim ts, kaplan
kaplan = MsgBox("Aynı Olanları Boyuyorum", vbYesNo, "Onay")
If kaplan = vbNo Then Exit Sub
Application.DisplayAlerts = False
kaplan = 3
For ts = 3 To Cells(65536, "B").End(xlUp).Row
If WorksheetFunction.CountIf(Range("A3:A65536"), Cells(ts, "B")) > 0 Then
Cells(ts, "B").Interior.ColorIndex = kaplan
Cells(ts, "D") = kaplan
kaplan = kaplan + 1
End If
Next
For ts = 3 To Cells(65536, "B").End(xlUp).Row
If WorksheetFunction.CountIf(Range("B3:B65536"), Cells(ts, "A")) > 0 Then
Cells(ts, "A").Interior.ColorIndex = WorksheetFunction.VLookup( _
Cells(ts, "A"), Range("B3:D65536"), 3, 0)
End If
Next
Range("D:D").ClearContents
Application.DisplayAlerts = True
MsgBox "Eşit Olanları Boyadım", vbInformation, "Bitiş"
End Sub

 

[dead cities]

Uğraştığınız için çok teşekkür ederim. ancak yine olmamış. her iki ayrı kolonda aynı olan değerleri aynı renk'e boyaması gerekiyor. yani diyelim A kolonunda ST360304636 değeri B kolonunda da var. bu değer her iki kolonda da yeşil renkte olsun. yine, A kolonunun başka bir satırında SA060839754 değeri bulunuyor ve bu değer B kolonunun herhangi bir satırında da mevcut. bu değer de örneğin kırmızı renge boyansın. tekrar teşekkürler.

 

[İhsan Tank]

Uğraştığınız için çok teşekkür ederim. ancak yine olmamış. her iki ayrı kolonda aynı olan değerleri aynı renk'e boyaması gerekiyor. yani diyelim A kolonunda ST360304636 değeri B kolonunda da var. bu değer her iki kolonda da yeşil renkte olsun. yine, A kolonunun başka bir satırında SA060839754 değeri bulunuyor ve bu değer B kolonunun herhangi bir satırında da mevcut. bu değer de örneğin kırmızı renge boyansın. tekrar teşekkürler.

ben deniyorum bir problem yok
başka arkadaş'a denettirdim gene problem olmadığını söyledi
bir de siz ilk dosyadan bahsediyorsanız olmadı falan diye birbirine eşit olmalı metin yazmışsanız metin rakam yazmışsanız rakam olmalı eşitlik sağlanmalı yani

 

[dead cities]

7 tane farklı renge boyanmış satır görünüyor. ancak bu satırlarda değer yok. sadece hücrenin üzeri renkli, mavi sarı, pembe falan.. hücrenin içindeki değer görünsün, sadece değer renklensin, örneğin kırmızı olsun, bu kırmızı ile boyanmış değerin aynısı, A hücresinde de kırmızı olsun. bu şekilde izah etmeye çalışmıştım, anlatamadığım için çok özür, saygılar.

 

[İhsan Tank]

7 tane farklı renge boyanmış satır görünüyor. ancak bu satırlarda değer yok. sadece hücrenin üzeri renkli, mavi sarı, pembe falan.. hücrenin içindeki değer görünsün, sadece değer renklensin, örneğin kırmızı olsun, bu kırmızı ile boyanmış değerin aynısı, A hücresinde de kırmızı olsun. bu şekilde izah etmeye çalışmıştım, anlatamadığım için çok özür, saygılar.

doğru boş hücreleri boyuyor sebebi ise karşılığı olduğu için
hepsi dolu olursa dolduğu şekle göre boyar.

 

[İhsan Tank]

B sütununda fazla boşluk var bunları görüyor ve karşılık olarak da boşluk gördüğünde otomatik veri olduğunu sayıyor

Option Explicit
Sub boya()
On Error Resume Next
Range("A3:B65536").Interior.Pattern = xlNone
Dim ts, kaplan
kaplan = MsgBox("Aynı Olanları Boyuyorum", vbYesNo, "Onay")
If kaplan = vbNo Then Exit Sub
Application.DisplayAlerts = False
kaplan = 3
For ts = 3 To Cells(65536, "A").End(xlUp).Row
If WorksheetFunction.CountIf(Range("A3:A65536"), Cells(ts, "B")) > 0 Then
Cells(ts, "B").Interior.ColorIndex = kaplan
Cells(ts, "D") = kaplan
kaplan = kaplan + 1
End If
Next
For ts = 3 To Cells(65536, "A").End(xlUp).Row
If WorksheetFunction.CountIf(Range("B3:B65536"), Cells(ts, "A")) > 0 Then
Cells(ts, "A").Interior.ColorIndex = WorksheetFunction.VLookup( _
Cells(ts, "A"), Range("B3:D65536"), 3, 0)
End If
Next
Range("D:D").ClearContents
Application.DisplayAlerts = True
MsgBox "Eşit Olanları Boyadım", vbInformation, "Bitiş"
End Sub

bu kod A sütunundaki veri sayısına göre çalışır. B sütununda buna göre 2 tane boşluk mevcut.
bunları doldurun ve karşılıklarınıda yazın kodu çalıştırın.

 

[Ömer]

Merhaba,

Alternatif olsun.

Eğer mükerrer veriler 56 dan fazla ise renk kodu sıfırlanıp tekrar renklendirmeye devam eder. Yalnız buradaki sorun farklı 2 kayıta aynı renk gelebilir.

Dilerseniz bunun için C sütununa 1-2-3... şeklinde aynı renklere farklı numara verdirilebilir.

Sub BulBoya()
 
    Dim i As Long, c As Range, Adr As String, say As Byte, artis As Byte
 
    [A:B].Interior.ColorIndex = 0
 
    For i = 3 To Cells(Rows.Count, "A").End(xlUp).Row
       With Range("B:B")
           Set c = .Find(Cells(i, "A"), LookIn:=xlValues, LookAt:=xlWhole)
           If Not c Is Nothing Then
               Adr = c.Address
               Do
                   artis = 1
                   If Cells(i, "A") <> "" Then
                       If say = 1 Then artis = 2
                       say = say + artis
                       Cells(i, "A").Interior.ColorIndex = say
                       Cells(c.Row, "B").Interior.ColorIndex = say
                   End If
 
                   If say Mod 56 = 0 Then say = 0
                   Set c = .FindNext(c)
               Loop While Not c Is Nothing And c.Address <> Adr
           End If
       End With
    Next i
 
    MsgBox "İşlemi Tamamladım.", vbInformation, "excel.web.tr"
 
End Sub

.