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)
On Error GoTo Son
If Intersect(Target, Range("e1:f" & [a65536].End(3).Row)) Is Nothing Then Exit Sub
If Cells(Target.Row, "e") = Cells(Target.Row, "f") Then
Range(Cells(Target.Row, "b"), Cells(Target.Row, "f")).Interior.ColorIndex = 6
Else
Range(Cells(Target.Row, "b"), Cells(Target.Row, "f")).Interior.ColorIndex = xlNone
End If
Son:
End Sub
Merhaba,ben buraya bayılıyorum bukadar hızlı ve net çözümler nediyim harikasınız
çok güzel çalışıyor
hocam bir şey daha rica edebilirmiyim
A hücresindeki rakamlar temizlenince E-F hücresindeki rakamlarda otamatikman temizlenebilirmi
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
Application.EnableEvents = False
If Not Intersect(Target, Range("e1:f" & [b65536].End(3).Row)) Is Nothing Then
If Target = "" Then Exit Sub
If Cells(Target.Row, "e") = Cells(Target.Row, "f") Then
Range(Cells(Target.Row, "b"), Cells(Target.Row, "f")).Interior.ColorIndex = 6
Else
Range(Cells(Target.Row, "b"), Cells(Target.Row, "f")).Interior.ColorIndex = xlNone
End If
End If
If Not Intersect(Target, Range("a1:a" & [b65536].End(3).Row)) Is Nothing Then
Range(Cells(Target.Row, "b"), Cells(Target.Row, "f")).Interior.ColorIndex = xlNone
Range(Cells(Target.Row, "e"), Cells(Target.Row, "f")).ClearContents
End If
Son:
If WorksheetFunction.CountA(Columns(1)) = 0 Then
Range("e" & Target.Row & ":f" & [b65536].End(3).Row).ClearContents
End If
Application.EnableEvents = True
End Sub