Merhaba,
ekli dosyadaki renk kodlarının ve yeni ekleyeceğim kodlara göre karşılarındaki hücreyi renklendirebilir miyim
Teşekkürler.
önce çalışmanıza bir modül ekleyip aşağıdaki kodu yapıştırın
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üzenleyin
Private 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
Worksheet_Change olayını çalışması için kodları ekledikten A sütunundaki verileri silip yeniden eklemelisiniz
BU arada dikkatimden kaçmış benim kullandığım yöntemin çalışabilmesi için dosyanızın xlsb yada xlsm gibi makro yazılabilen formatta olması gerekiyor
hücre içi formüllerden anlamam bu sorun çıkarır mı?
sayfa1 deki renk kodlarını sayfa2'ye yapıştırıp dener misiniz?
Not: Yanlış dosyayı yüklemiştim düzelttim