DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
If Intersect(Target, [C:C]) Is Nothing Or Target.Row < 16 Then Exit Sub
Set c = Range("O:O").Find(Target.Value, LookIn:=xlValues)
If Not c Is Nothing Then
With Target
.Font.Color = c.Font.Color
.Font.Bold = c.Font.Bold
End With
Else
Target.Font.Color = xlAutomatic
End If
End Sub
Merhaba,
Aşağıdaki kodları ilgili sayfanı kod bölümüne kopyalayıp deneyiniz.
Kod:Private Sub Worksheet_Change(ByVal Target As Range) Dim c As Range If Intersect(Target, [C:C]) Is Nothing Or Target.Row < 16 Then Exit Sub Set c = Range("O:O").Find(Target.Value, LookIn:=xlValues) If Not c Is Nothing Then With Target .Font.Color = c.Font.Color .Font.Bold = c.Font.Bold End With Else Target.Font.Color = xlAutomatic End If End Sub
Merhaba,
Sizin istediğiniz klasik koşullu biçim ile uyumlu değil. O yüzden makro ile yaptım.
Ya da varsa bir yolu ben bilmiyorum.
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C16:C221]) Is Nothing Then Exit Sub
If WorksheetFunction.CountIf(Range("O17:O19"), Target) = 0 Then Exit Sub
Target.Font.Color = Cells(WorksheetFunction.Match(Target, Range("O17:O19"), 0) + 16, 15).Font.Color
End Sub
Merhaba.
Aşağıdaki KOD'u sayfanın (Modüle değil) kod bölümüne uygulayın.
(alt tarafta sayfa adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
açılan ekranın sağ tarafındaki boş alana KOD'u yapıştırın)C sütunundaki veri doğrulama seçeneklerinden seçim değiştirerek test ediniz.Kod:Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, [C16:C221]) Is Nothing Then Exit Sub If WorksheetFunction.CountIf(Range("O17:O19"), Target) = 0 Then Exit Sub Target.Font.Color = Cells(WorksheetFunction.Match(Target, Range("O17:O19"), 0) + 16, 15).Font.Color End Sub
Sub renklen()
son = Cells(Rows.Count, "e").End(3).Row
For i = 18 To son
If Cells(i, "c") = Cells(i, "o") Then
a = Cells(i, "o").Font.ColorIndex
Cells(i, "c").Font.ColorIndex = a
End If
Next
End Sub
Merhaba,
Tag'daki kodu kullanabilirsiniz. Anlık değişimlerle değilde siz istediğinizde çalışacak bir kod daha iyi olur diye düşünüyorum.
Kod:Sub renklen() son = Cells(Rows.Count, "e").End(3).Row For i = 18 To son If Cells(i, "c") = Cells(i, "o") Then a = Cells(i, "o").Font.ColorIndex Cells(i, "c").Font.ColorIndex = a End If Next End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C16:C221]) Is Nothing Then Exit Sub
For a = 16 To 221
If WorksheetFunction.CountIf(Range("O17:O19"), Cells(a, 3)) = 0 Then GoTo 10
Cells(a, 3).Font.Color = Cells(WorksheetFunction.Match(Cells(a, 3), Range("O17:O19"), 0) + 16, 15).Font.Color
10: Next
End Sub
Hocam o sütunundaki rengi değiştirdiğimde c sütunundaki seçtiklerim eski renginde kalıyor. Onu nasıl düzeltirim, o sütununu değiştirdimde c sütunundaki değerlerde hemen değişsin istiyorum ama olmuyor![]()
Merhaba, gönderdiğim kod'u aşağıdaki ile değiştirin.Kod:Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, [C16:C221]) Is Nothing Then Exit Sub For a = 16 To 221 If WorksheetFunction.CountIf(Range("O17:O19"), Cells(a, 3)) = 0 Then GoTo 10 Cells(a, 3).Font.Color = Cells(WorksheetFunction.Match(Cells(a, 3), Range("O17:O19"), 0) + 16, 15).Font.Color 10: Next End Sub
Teşekkürler hocam başta sana sonra diğer arkadaşlara
Süper bir tablo oldu emeğinize sağlık