Hücredeki sayı artmış mı azalmış mı sorgulaması

[doruk89]

Merhaba,

A1 hücresinde 10 sayısının olduğunu varsayalım. Ardından, A1 hücresindeki 10 yerine 15 yazdık, son olarak da 15 yerine 8 yazdık.

koşullu biçimlendirme ya da makro ile bu hücredeki sayıda, bir öncekine göre artış varsa hücreyi yeşil, azalış varsa kırmızı yapabilir miyim?

Yan hücresine "arttı" ya da "azaldı" gibi bir şey de yazdırsam olur.

Teşekkürler.

 

[Ömer]

Merhaba,

Sayfanın kod bölümüne kopyalayıp deneyiniz.

Public deg As Double

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [A1]) Is Nothing Then Exit Sub
    With Target
        .Interior.ColorIndex = 0
        .Offset(0, 1) = ""
        If .Value = "" Then Exit Sub
        If .Value > deg Then
            .Interior.ColorIndex = 10
            .Offset(0, 1) = "Arttı"
        ElseIf .Value < deg Then
             .Interior.ColorIndex = 3
             .Offset(0, 1) = "Azaldı"
        Else
            .Offset(0, 1) = "Değişmedi"
        End If
    End With
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    deg = [A1]
End Sub

 

[doruk89]

Teşekkür ederim Ömer Bey ilginiz için, bu kod çalıştı.

Tabii ben çok düz düşündüm o yüzden az bilgi verdim. Birden fazla hücre için mesela alt alta 10-15 hücre için bunu uygulamak istesem nasıl yapabilirim?

Ek olarak: Kodu etkiler mi bilmiyorum ama bu hücrelerde formül var. Web'den çektiğim bir sayıyı her dakika güncelliyor. Onun artış ya da azalışını sorgulamak istiyorum.

 

[Ömer]

Gerçek yapı üzerinde düşünmek gerekir.
Daha detaylı bilgi vermeniz gerekiyor. Ayrıca renklenecek alandaki formül nedir?

 

[doruk89]

Hocam dosyası sadeleştirdim, iletiyorum. Kısaca da açıklayayım.

dosya.xlsx

Görüntüle ve Yandex.Disk'ten indir

disk.yandex.com.tr

Dış veri çekmeyle "DATA" sayfasını oluşturdum. "LİSTE" sayfasında da maliyet hesabı yaptım. "KAR/ZARAR" sütununda; şu an eksideyse kırmızı, artıdaysa yeşil dolgulu yaptım.

Veriler dakikalık güncelleniyor. Ben istiyorum ki; "KAR/ZARAR" sütunundaki hücrelerde dakikalık olarak artış olduysa dolgu yeşil, azalış olduysa da kırmızı olsun.

Teşekkür ederim.

 

[Ömer]

Liste sayfasının kod bölümüne kopyalayınız.
F sütunundaki koşullu biçimlendirmeleri silebilirsiniz. Birde F sütununa yazdığınız formülü kodların içine ekledim artık o bölümde formül görmeyecekseniz. Bu yüzden dilerseniz kodları ilgili bölüme kopyalamadan önce F sütunundaki mevcut değerleri kopyalayıp aynı bölüme değerleri yapıştır yapın.

Private Sub Worksheet_Calculate()

   Dim a, b, alan, s As Long, son As Long, i As Long, hcr As Range

    With Application
        .ScreenUpdating = False
        .Calculation = xlManual
    End With
   
    son = Cells(Rows.Count, "A").End(xlUp).Row
    alan = Range("F2:F" & son).Value

    ReDim dizi(1 To son)

    For i = LBound(alan) To UBound(alan)
        s = s + 1
        dizi(s) = alan(i, 1)
    Next i
   
    Application.Calculation = xlAutomatic
   
    Set alan = Range("F2:F" & son)
    alan.ClearContents
   
    s = 1
    For Each hcr In alan
        With hcr
            .Value = (Cells(.Row, "E") - Cells(.Row, "B")) * Cells(.Row, "C")
            If .Value > dizi(s) Then
                .Interior.ColorIndex = 10
                .Offset(0, 1) = "Arttı"
            ElseIf .Value < dizi(s) Then
                 .Interior.ColorIndex = 3
                 .Offset(0, 1) = "Azaldı"
            Else
                '.Interior.ColorIndex = 0
                .Offset(0, 1) = "Değişmedi"
            End If
        End With
        s = s + 1
    Next
   
    Application.ScreenUpdating = True
   
End Sub

 

[doruk89]

Tekraren çok teşekkür ederim Ömer Bey, bu kod istediğim gibi çalışıyor.

 

[Ömer]

Rica ederim.

ReDim dizi(1 To 10) satırını ReDim dizi(1 To son) olarak güncelledim. Sizde değiştirirsiniz. Deneme yaptığımdan ilk etapta değiştirmeyi atlamışım.