DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Kod, imlecin nerede olduğunu kolayca görmenizi sağlar.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.Interior.Color = xlNone
ActiveCell.Interior.Color = 15261367
End Sub
Kodu, ilgili sayfanın KOD bölümüne yapıştırınız, İMLECİ farklı yönlerde hareket etirip deneyiniz.
Merhaba;
Alternatif olsun.
Sayfanın kod bölümüne;
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Satır As Range, Sütun As Range
Set Satır = Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 256))
Set Sütun = Range(Cells(1, ActiveCell.Column), Cells(65536, ActiveCell.Column))
Cells.FormatConditions.Delete
With ActiveCell
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:=1
.FormatConditions(1).Font.Bold = True
.FormatConditions(1).Interior.ColorIndex = 3
End With
End Sub
Ekleyerek deneyin.
NOT: Kodlar alıntıdır.
İyi çalışmalar.
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Satir As Range, Sutun As Range
If Application.CutCopyMode = xlCopy Or Application.CutCopyMode = xlCut Then Exit Sub
Set Satir = Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, Columns.Count))
Set Sutun = Range(Cells(1, ActiveCell.Column), Cells(Rows.Count, ActiveCell.Column))
Cells.FormatConditions.Delete
With Satir
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:=1
.FormatConditions(1).Font.Bold = True
.FormatConditions(1).Interior.ColorIndex = 37
End With
With Sutun
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:=1
.FormatConditions(1).Font.Bold = True
.FormatConditions(1).Interior.ColorIndex = 37
End With
With ActiveCell
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:=1
.FormatConditions(1).Font.Bold = True
.FormatConditions(1).Interior.ColorIndex = 40
End With
End Sub
Deneyiniz.
Sayfanızın kod bölümüne uygulayınız.
Kod:Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim Satır As Range, Sütun As Range If Application.CutCopyMode = xlCopy Or Application.CutCopyMode = xlCut Then Exit Sub Set Satır = Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, Columns.Count)) Set Sütun = Range(Cells(1, ActiveCell.Column), Cells(Rows.Count, ActiveCell.Column)) Cells.FormatConditions.Delete With Satır .FormatConditions.Delete .FormatConditions.Add Type:=xlExpression, Formula1:=1 .FormatConditions(1).Font.Bold = True .FormatConditions(1).Interior.ColorIndex = 37 End With With Sütun .FormatConditions.Delete .FormatConditions.Add Type:=xlExpression, Formula1:=1 .FormatConditions(1).Font.Bold = True .FormatConditions(1).Interior.ColorIndex = 37 End With With ActiveCell .FormatConditions.Delete .FormatConditions.Add Type:=xlExpression, Formula1:=1 .FormatConditions(1).Font.Bold = True .FormatConditions(1).Interior.ColorIndex = 40 End With End Sub
O nasıl olur peki Korhan bey?Tüm satır ve sütunda renklendirme yaptığı için yavaşlama olabilir.
Bunun yerine ekranda görünen satır ve sütun değerleri dikkate alınırsa hız artışı olabilir.
alıntı kod alternatif
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Cells.Interior.ColorIndex = xlColorIndexNone
ActiveCell.EntireColumn.Interior.ColorIndex = 15 'Sütun Rengi
ActiveCell.EntireRow.Interior.ColorIndex = 15 ' Satır Rengi
ActiveCell.Cells.Interior.ColorIndex = 4 ' Hücre Rengi
End Sub
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim X_1 As Long, X_2 As Long, Y_1 As Integer, Y_2 As Integer, Satir As Range, Sutun As Range
If Application.CutCopyMode = xlCopy Or Application.CutCopyMode = xlCut Then Exit Sub
X_1 = ActiveWindow.VisibleRange.Row
X_2 = Range(Split(ActiveWindow.VisibleRange.Address, ":")(1)).Row
Y_1 = ActiveWindow.VisibleRange.Column
Y_2 = Range(Split(ActiveWindow.VisibleRange.Address, ":")(1)).Column
Set Satir = Range(Cells(ActiveCell.Row, Y_1), Cells(ActiveCell.Row, Y_2))
Set Sutun = Range(Cells(X_1, ActiveCell.Column), Cells(X_2, ActiveCell.Column))
Cells.FormatConditions.Delete
With Satir
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:=1
.FormatConditions(1).Font.Bold = True
.FormatConditions(1).Interior.ColorIndex = 37
End With
With Sutun
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:=1
.FormatConditions(1).Font.Bold = True
.FormatConditions(1).Interior.ColorIndex = 37
End With
With ActiveCell
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:=1
.FormatConditions(1).Font.Bold = True
.FormatConditions(1).Interior.ColorIndex = 40
End With
End Sub
Deneyiniz.
Kod:Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim X_1 As Long, X_2 As Long, Y_1 As Integer, Y_2 As Integer, Satir As Range, Sutun As Range If Application.CutCopyMode = xlCopy Or Application.CutCopyMode = xlCut Then Exit Sub X_1 = ActiveWindow.VisibleRange.Row X_2 = Range(Split(ActiveWindow.VisibleRange.Address, ":")(1)).Row Y_1 = ActiveWindow.VisibleRange.Column Y_2 = Range(Split(ActiveWindow.VisibleRange.Address, ":")(1)).Column Set Satir = Range(Cells(ActiveCell.Row, Y_1), Cells(ActiveCell.Row, Y_2)) Set Sutun = Range(Cells(X_1, ActiveCell.Column), Cells(X_2, ActiveCell.Column)) Cells.FormatConditions.Delete With Satir .FormatConditions.Delete .FormatConditions.Add Type:=xlExpression, Formula1:=1 .FormatConditions(1).Font.Bold = True .FormatConditions(1).Interior.ColorIndex = 37 End With With Sutun .FormatConditions.Delete .FormatConditions.Add Type:=xlExpression, Formula1:=1 .FormatConditions(1).Font.Bold = True .FormatConditions(1).Interior.ColorIndex = 37 End With With ActiveCell .FormatConditions.Delete .FormatConditions.Add Type:=xlExpression, Formula1:=1 .FormatConditions(1).Font.Bold = True .FormatConditions(1).Interior.ColorIndex = 40 End With End Sub
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Application.CutCopyMode = xlCopy Or Application.CutCopyMode = xlCut Then Exit Sub
Cells.FormatConditions.Delete
With ActiveCell
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:=1
.FormatConditions(1).Font.Bold = True
.FormatConditions(1).Interior.ColorIndex = 3
End With
End Sub
Ben biraz daha fonksiyonel olsun diye satır ve sütun renklendirmesini de dahil etmiştim.
Sadece aktif hücre için aşağıdaki kodu deneyiniz.
Kod:Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Application.CutCopyMode = xlCopy Or Application.CutCopyMode = xlCut Then Exit Sub Cells.FormatConditions.Delete With ActiveCell .FormatConditions.Delete .FormatConditions.Add Type:=xlExpression, Formula1:=1 .FormatConditions(1).Font.Bold = True .FormatConditions(1).Interior.ColorIndex = 3 End With End Sub