Çözüldü KoşB. ile İki Hücre Arası Fark Varsa Dolgu Rengi Ayarlama

[RBozkurt]

Merhaba,

Excelde koşullu biçimlendirme ile;
P hücresi ile Q hücresi veya Q hücresi ile P hücresi arasındaki fark %20'den fazla ise R hücresi dolgusu KIRMIZI olsun.

Yapay zekada çözemedim. Yardımcı olabilirseniz sevinirim.

 

[RBozkurt]

Makro ile çözdüm.

Private Sub Worksheet_Change(ByVal Target As Range)
    ' ... %20 Fark ...

    ' P ve Q hücreleri arasındaki farkı kontrol et
    If Not Intersect(Target, ws.Range("P:Q")) Is Nothing Then
        Dim pValue As Variant
        Dim qValue As Variant
        Dim largerValue As Double
        Dim smallerValue As Double
        Dim difference As Double
        Dim isDifferenceGreaterThan20Percent As Boolean

        ' P ve Q hücrelerinden değerleri al
        pValue = ws.Cells(row, 16).Value ' P sütunu
        qValue = ws.Cells(row, 17).Value ' Q sütunu

        ' Q hücresinin boş olup olmadığını kontrol et
        If IsEmpty(qValue) Then
            ws.Cells(row, 18).Interior.ColorIndex = xlNone ' R rengini temizle
        Else
            ' P hücresinin boş olup olmadığını kontrol et
            If IsEmpty(pValue) Then
                ws.Cells(row, 18).Interior.ColorIndex = xlNone ' P boşsa, R rengini temizle
            Else
                ' Büyük ve küçük değeri belirle
                If pValue > qValue Then
                    largerValue = pValue
                    smallerValue = qValue
                Else
                    largerValue = qValue
                    smallerValue = pValue
                End If

                ' Farkı hesapla
                If largerValue <> 0 Then
                    difference = Abs(largerValue - smallerValue) / largerValue
                    isDifferenceGreaterThan20Percent = (difference > 0.2)
                Else
                    isDifferenceGreaterThan20Percent = False
                End If

                ' R hücresinin dolgu rengini ayarla
                If isDifferenceGreaterThan20Percent Then
                    ws.Cells(row, 18).Interior.Color = RGB(255, 0, 0) ' KIRMIZI
                Else
                    ws.Cells(row, 18).Interior.ColorIndex = xlNone ' Rengi temizle
                End If
            End If
        End If
    End If
    
    ' ... %20 Fark ...
End Sub

 

[catalinastrap]

Dosyanız Ektedir