Kendini Yenilemeyen Formül

[Rheago]

Merhaba arkadaşlar. Seçili hücrenin rengine sahip hücreleri saydırmak için aşağıdaki vba kodunu kullanmaktayım. Ama şöyle bir sorun var. Bu formül kendini yenilemiyor. Ancak formülü yazdığım hücreye çift tıklayıp sonra enter dersem güncelliyor. Otomatikleştirmenin yolu var mı? Excel ayarlarında hesaplama otomatikte zaten.

Function Renksay(range_data As Range, criteria As Range) As Long
Dim datax As Range
Dim xcolor As Long
xcolor = criteria.Interior.ColorIndex
For Each datax In range_data
If datax.Interior.ColorIndex = xcolor Then
Renksay = Renksay + 1
End If
Next datax
End Function

 

[EmrExcel16]

Hücrenin biçimlendirmesi Metin mi acaba.

 

[Muzaffer Ali]

Bir hücrenin rengi değiştiğinde otomatik çalışan kod yok.

Ancak Class ile yeni bir Renk değiştirme olayı eklenmesi lazım. Aşağıdaki kodları yabancı bir siteden bularak sizin kodlarınıza uyarladım.

Yeni bir Class Module oluşturun. Aşağıdaki kodları Class Module kopyhalayın.

Option Explicit
Private WithEvents cmb As Office.CommandBars
Private bCancel As Boolean
Private bAllCellsCounted As Boolean
Private vCellCurColor() As Variant
Private vCellPrevColor() As Variant
Private sCellAddrss() As String
Private sVisbRngAddr As String
Private i As Long
Private oSh As Worksheet
Private oCell As Range

Public Sub ApplyToSheet(Sh As Worksheet)
    Set oSh = Sh
End Sub

Public Sub StartWatching()
    Set cmb = Application.CommandBars
End Sub

Private Sub Class_Initialize()
    bAllCellsCounted = False
End Sub


Private Sub cmb_OnUpdate()

    If Not ActiveSheet Is oSh Then Exit Sub
    bCancel = False
    i = -1
VisibleRngChanged:
    If sVisbRngAddr <> ActiveWindow.VisibleRange.Address _
        And sVisbRngAddr <> "" Then
        Erase sCellAddrss
        Erase vCellCurColor
        Erase vCellPrevColor
        sVisbRngAddr = ""
        bAllCellsCounted = False
        GoTo VisibleRngChanged
    End If
    On Error Resume Next
        For Each oCell In ActiveWindow.VisibleRange.Cells
            ReDim Preserve sCellAddrss(i + 1)
            ReDim Preserve vCellCurColor(i + 1)
            sCellAddrss(i + 1) = oCell.Address
            vCellCurColor(i + 1) = oCell.Interior.Color
            If vCellPrevColor(i + 1) <> vCellCurColor(i + 1) Then
                If bAllCellsCounted = True Then
                    oCell.Interior.Color = vCellPrevColor(i + 1)
                   
                    If Not bCancel Then
                        oCell.Interior.Color = vCellCurColor(i + 1)
                        vCellPrevColor(i + 1) = vCellCurColor(i + 1)
                    Else
                        oCell.Interior.Color = vCellPrevColor(i + 1)
                        vCellCurColor(i + 1) = vCellPrevColor(i + 1)
                    End If
                    CallByName oSh, _
                    "CellColorChanged", VbMethod, oCell, oCell.Interior.Color, bCancel
                    bCancel = False
                End If
            End If
                i = i + 1
            If i + 1 >= ActiveWindow.VisibleRange.Cells.Count Then
                bAllCellsCounted = True
                ReDim Preserve vCellPrevColor(UBound(vCellCurColor))
                vCellPrevColor = vCellCurColor
            End If
            vCellPrevColor(i + 1) = vCellCurColor(i + 1)
        Next
    On Error GoTo 0
        sVisbRngAddr = ActiveWindow.VisibleRange.Address

End Sub

Aşağıdaki kodları da renk sayımı yaptığınız sayfanın kod kısmına yapıştırın.

Private oCellColorMonitor As Class1

Public Sub CellColorChanged(Cell As Range, Color As Variant, Cancel As Boolean)
    Application.Calculate
End Sub

Private Sub Worksheet_Activate()
    Set oCellColorMonitor = New Class1
    oCellColorMonitor.ApplyToSheet ActiveSheet
    oCellColorMonitor.StartWatching
End Sub

Private Sub Worksheet_Deactivate()
    Set oCellColorMonitor = Nothing
End Sub

Şimdi renk sayımı yaptığınız sayfadan başka bir sayfayı açın sonra tekrar renk sayımı yaptığınız sayfayı açın.

Bundan sonra kullanıcı tanımlı fonksiyonunuz otomatik çalışacaktır.

 

[Korhan Ayhan]

Alternatif,

Aşağıdaki satırı fonksiyonunuzun içine yazın.

Dim ile başlayan satırların altına yazabilirsiniz.

Application. Volatile True

Bu aşamadan sonra sayfada renk değiştirip F9 tuşuna basmanız yeterli olacaktır.

 

[Rheago]

Çok teşekkür ederim arkadaşlar.