Merhaba,
ekli dosyadaki renk kodlarının ve yeni ekleyeceğim kodlara göre karşılarındaki hücreyi renklendirebilir miyim
Teşekkürler.
![Çözüldü](images/icons/cozuldu.png)
Option Compare Text
Function xRenk(ByVal Rng As Range) ' As String
If Len(Rng.Value & "") > 0 Then Rng.Offset(, 1).Interior.Color = HEXCOL2RGB(Rng.Value) Else Rng.Offset(, 1).Interior.Color = vbWhite
End Function
Public Function HEXCOL2RGB(ByVal HexColor As String) As String
Dim Red As String, Green As String, Blue As String
HexColor = Replace(HexColor, "#", "")
Red = Val("&H" & Mid(HexColor, 1, 2))
Green = Val("&H" & Mid(HexColor, 3, 2))
Blue = Val("&H" & Mid(HexColor, 5, 2))
HEXCOL2RGB = RGB(Red, Green, Blue)
End Function
sonrada ilgili sayfanın olayını aşağıdaki gibi düzenleyinPrivate Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:A")) Is Nothing Then 'sadece B,C sütununa bakar
Application.EnableEvents = False
On Error GoTo hata
Dim cll As Range
AdrX = Target.Address & ":" & Target.Address
xDz = Split(AdrX, "$")
ilk = xDz(2)
Son = Val(xDz(4))
If ilk = "1:" Then ilk = "2:"
If Son < 2 Then Son = 2
Set Trgt = Range("A" & ilk & "A" & Son)
For Each cll In Trgt
Set Rng = cll
xRenk (Rng)
Next cll
End If
hata:
Application.EnableEvents = True
End Sub
dilerim işinize yarar