Eşit olan veriyi renklendirmek..!

[sensizsoldum]

Merhaba
STOK ve TİP TAKİP sayfası olmak üzere çalışmada bu isimle sayfalar bulunmakta, TİP TAKİP sayfası E3:E aralığında olan veri, STOK sayfası A3:A aralığında kaç tane varsa STOK sayfası A ve D hücreleri kırmızı renk ile renklensin istiyorum.
Örneğin: TİP TAKİP sayfası E18de (8627 48 0 54) yazılı. STOK sayfası A3:A aralığının farklı hücrelerinde toplamda 73 tane (8627 48 0 54) içermekte. İçeren hücrelerin A ve D hücrelerinin kırmızı renk olmasını bir buton yardımıyla yapabilir miyiz?
Konu hakkında yardımlarınız için teşekkür ederim iyi çalışmalar dilerim.
Saygılarımla.

 

[YUSUF44]

Daha önceki konudan devam etseydiniz daha iyi olurdu.



Çözüm için:

TİP TAKİP sayfasında E3:E aralığını seçin ve STOK olarak adlandırın.

STOK sayfasında A3: D hücrelerini seçip koşullu biçimlendirme olarak aşağıdaki formülü girin ve biçim ayarını yapın:

=VE(DEĞİL($A3="");EĞERSAY(STOK;$A3)>0)

 

[sensizsoldum]

Merhaba Yusuf Bey,
Bunu makro da bir buton yardımıyla yapabilir miyiz? Bunu yapmak istediğim sayfaya koşul işlemiyor. Çok enteresan bir durum var ortada. O yüzden makro olması gerekiyor.
Teşekkür ederim. İyi çalışmalar dilerim.

 

[YUSUF44]

O konuda bilgim yok, geçen gün oldu demiştiniz, niye bugün olmasın ki? E3:E'ye STOK adını verdiniz değil mi?

 

[sensizsoldum]

Merhaba Yusuf Bey,
Bu konu iki farklı sayfa arasında olacak. Önceki yazdığınız formül tek sayfa üzerinden olan bir durumdu. Ayrıca her zaman gerekli olacak bir koşul olmadığından, ihtiyac duyulduğu zaman kullanılması için makro gerekiyor.

 

[Emir Hüseyin Çoban]

. . .

Sub KOD()

Application.ScreenUpdating = False
Dim S1 As Worksheet
Dim S2 As Worksheet
Set S1 = Sheets("TİP TAKİP")
Set S2 = Sheets("STOK")

S1sonsat = S1.[e65536].End(3).Row
S2sonsat = S2.[e65536].End(3).Row

S2.Range("A3:D65536").Font.ColorIndex = 0

For i = 3 To S1sonsat
For a = 3 To S2sonsat

If S1.Cells(i, "E") Like "*" & S2.Cells(a, "E") & "*" Then
S2.Cells(a, "a").Font.ColorIndex = 3
S2.Cells(a, "d").Font.ColorIndex = 3
Else
End If

Next a
Next i
Application.ScreenUpdating = True
MsgBox " B İ T T İ "

End Sub

. . .

 

[sensizsoldum]

Merhaba Hüseyin Bey,
Herhangi bir sonuç alamadım. Ne hata Nede hücrelerin rengi ile igili...

 

[Emir Hüseyin Çoban]

. . .

Örnek bir dosya ekleyin, üzerinde deneyelim.

. . .

 

[sensizsoldum]

Merhaba Hüseyin Bey,
Örnek dosya eklenmiştir.

Bilginize.

 

[Emir Hüseyin Çoban]

. . .

E sütunu ile A sütunu karşılaştırılacakmış, gözümden kaçmış. Aşağıdaki kodları deneyiniz.

Sub KOD()

Application.ScreenUpdating = False
Dim S1 As Worksheet
Dim S2 As Worksheet
Set S1 = Sheets("TİP TAKİP")
Set S2 = Sheets("STOK")

S1sonsat = S1.[e65536].End(3).Row
S2sonsat = S2.[a65536].End(3).Row

S2.Range("A3:D65536").Font.ColorIndex = 0

For i = 3 To S1sonsat
For a = 3 To S2sonsat

If S1.Cells(i, "E") Like "*" & S2.Cells(a, "A") & "*" Then
S2.Cells(a, "a").Font.ColorIndex = 3
S2.Cells(a, "d").Font.ColorIndex = 3
Else
End If

Next a
Next i
Application.ScreenUpdating = True
MsgBox " B İ T T İ "

End Sub

. . .

 

[sensizsoldum]

Merhaba Hüseyin bey,
Evet düzeldi şimdi ama, bunun yazı renkleri değişiyor. Dolgu rengini kırmızı yaparsınız diye umuyordum.

 

[Emir Hüseyin Çoban]

. . .

Ben yaparım sorun değil de, sizinde yapabiliyor olmanız gerekiyor.

S2.Range("A365536").Font.ColorIndex = 0

S2.Range("A3:D65536").Interior.ColorIndex = xlNone

. . .

S2.Cells(a, "a").Font.ColorIndex = 3
S2.Cells(a, "d").Font.ColorIndex = 3

S2.Cells(a, "a").Interior.ColorIndex = 3
S2.Cells(a, "d").Interior.ColorIndex = 3

. . .

 

[sensizsoldum]

Hüseyin Bey,
Af buyurun, gerekli düzeltilmeleri yaptım ama sadece a ve d sütunlarındaki hücrelerde renklenme oluyor. B ve C de bir değişiklik yok. Acaba bir yerlerde eksikmi anlattım.

 

[Emir Hüseyin Çoban]

. . .

S2.Cells(a, "a").Interior.ColorIndex = 3
S2.Cells(a, "d").Interior.ColorIndex = 3

yerine aşağıdakileri deneyinizi.

S2.range("a" & a & ":d" & a).Interior.ColorIndex = 3

. . .

 

[sensizsoldum]

Günaydın Hüseyin Bey,
Elinize bilginize sağlık. Çok teşekkür ederim.

İyi çalışmalar dilerim.


Saygılarımla.