Application Calculate hk.

[recepkull]

Arkadaşlar seçili hücrenin bulunuğu satırı renklendirmek için aşağıdaki gibi bir kod kullanıyorum
Sayfa içersine;

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Application.CutCopyMode = False Then
    Application.Calculate
End If
End Sub

Koşullu biçimlendirme;

=YADA(HÜCRE("row")=SATIR())

Ben bu kodlamayı çoğu sayfada kullanıyorum ve sayfa içine yazılan koddaki Application.Calculate ifadesi sayfanın yavaşlamasına sebep oluyor. Bu kodlamaya alternatif olarak başka bir kod var mıdır acaba ?

 

[Korhan Ayhan]

Linkte farklı uygulamalar mevcut. İnceleyip kendi dosyanıza uyarlayınız.

Soru - hareket imleci rengi

Arkadaşlar excelde hareket imlecinin rengini nasıl değiştirebilir ya da kalınlaştırabilirim? İmlecin nerede olduğu belli olmadığından hangi hücreye işlem yaptığım belli olmuyor. Teşekkürler.

www.excel.web.tr

Not: Benim önerdiğim kodlar koşullu biçimlendirme uygulamasıdır. Ama Calculation işlemine gerek duymaz.

 

[recepkull]

Hocam sayfaların 2 si hariç diğer hepsinde sadece yukarıda bahsettiğim koşullandırma var. O iki sayfada da birden fazla koşullandırma var.

Örn.

 

[Korhan Ayhan]

Ben mesajımı editlemiştim. Siz o arada sanırım mesajınızı yazdınız.

Önceki mesajımda verdiğim linki inceleyiniz.

 

[recepkull]

Deneyiniz.

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

Hocam verdiğiniz linki inceledim şu kod çok işime yaradı ancak ekranda görünen satır ve sütunlar değilde belli bir alandaki satır ve sütunların renklenmesi için kodda nasıl bir değişiklik yapmam gerekiyor ? Örn. A1:Q18 aralığı.

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Satir As Range, Sutun As Range
   
    Cells.FormatConditions.Delete
    
    If Application.CutCopyMode = xlCopy Or Application.CutCopyMode = xlCut Then Exit Sub
    If Intersect(Target, Range("A1:Q18")) Is Nothing Then Exit Sub
   
    Set Satir = Cells(ActiveCell.Row, 1).Resize(1, ActiveCell.Column)
    Set Sutun = Cells(1, ActiveCell.Column).Resize(ActiveCell.Row, 1)
   
    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

 

[recepkull]

Hocam bu şekilde sonuç verdi. İlgile alanda geri kalan satır ve sütunda renklendirme olmadı.

 

[Korhan Ayhan]

Bu şekilde deneyiniz.

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Satir As Range, Sutun As Range
   
    Cells.FormatConditions.Delete
    
    If Application.CutCopyMode = xlCopy Or Application.CutCopyMode = xlCut Then Exit Sub
    If Intersect(Target, Range("A1:Q18")) Is Nothing Then Exit Sub
   
    Set Satir = Cells(ActiveCell.Row, 1).Resize(1, 17)
    Set Sutun = Cells(1, ActiveCell.Column).Resize(18, 1)
   
    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

 

[recepkull]

Hocam kodu örnek dosyada denediğim için önce fark edememiştim şimdi asıl dosyamda denedim ilgili aralıktaki diğer koşullu biçimlendirmeleri siliyormuş :/

 

[Korhan Ayhan]

Eğer ilgili aralıktaki koşullu biçimlendirmelerinizin sayısı sabitse, yani değişmeyecekse çözüm üretilebilir.

 

[recepkull]

Hocam dosyamın aslı bu. Detaylar, Araçlar, Raporlar, Personel sayfalarında koşullu biçimlendirmeler var.

 

[Korhan Ayhan]

Hangi sayfada bu işlem olacak?

 

[recepkull]

6 sayfada olacak hocam. Detaylar, Araçlar, Arızalar, Yakıt, Raporlar ve Personel sayfaları.

 

[recepkull]

Ben verdiğiniz koda göre Arızalar ve Yakıt sayfasını yapabiliyorum ama diğer 4 sayfada kullandığım başka koşullu biçimlendirme olduğu için kod onları siliyor.

 

[Korhan Ayhan]

Dosyanızı yedekleyerek ekteki dosyadaki kodları kendi dosyanıza uyarlayıp deneyiniz.

Modül1 de ve sayfanın arka planında kodlar var. İkisini de kendi dosyanıza uyarlamanız gerekiyor.

 

[recepkull]

Hocam çok uğraştırdım sizi hakkınızı helal edin elinize emeğinize sağlık.