Soru Makro ile 0dan küçükse renklendirme hk.

[balanar]

C12 hücresinden başlayıp TL tutarı yazdığımda D12'den başlayıp çıkararak düşüm yapıyor..

Benim burada yapmak istediğim şu..

D12'den itibaren aşağaıya doğru kaç satır olacak bilemiyoruz kesintiye göre değişiyor. 0'a eşit veya küçük olduğunda sadece o hücrenin KIRMIZI renklenmesini istiyorum.

For Each c In Range("D12:D")
    Select Case c.Value
        Case Is <= 0
            c.Interior.ColorIndex = 3
    End Select
Next

şunu kullandığımda boş hücreleride kırmızı işaretliyor. Halbuki benim istediğim 0'a eşit veya altında olursa kırmızı işaretlemesi..

Formülle değilde makro ile yapmamız önemli. Bu durumu nasıl çözebilirim

 

[balanar]

Dim a As Byte
son = Cells(Rows.Count, "D").End(3).Row
For a = 2 To son
    If Cells(a, "D") <= "1" Then
        With Range("D" & a & ":D" & a)
            .Interior.ColorIndex = 3
        End With
    Else
    If Cells(a, "D") <= "1" Then
        With Range("D" & a & ":D" & a)
            .Interior.ColorIndex = 3

        End With
    End If
    End If
Next

şu şekilde yaptım fakat. C'ye girdiğim tl tutarı sildiğimde rakam 0 dan büyükse tekrar beyaz nasıl yapabilrim

 

[yanginci34]

Koşullu biçimlendirme ile yapılan örneği incelermisiniz.
Umarım işinizi görür.

 

[balanar]

Hocam makro olarak lazim. Teşekkür ederim yinede

 

[AdemCan]

İlk mesajda paylaştığınız kod içinde 2. bir koşul ekleyerek kullanabilirsiniz.
Boş hücrelerin dolgu rengini kaldırır.

For Each c In Range("D12:D20")
    Select Case c.Value
        Case Is = ""
            c.Interior.ColorIndex = xlNone
        Case Is <= 0
            c.Interior.ColorIndex = 3
    End Select
Next

 

[balanar]

hocam diyelim yazdık değeri kırmızı oldu, değeri sildiğimizde düzenlemek için beyaza dönmüyor. Orada sıkıntı yaşıyorum

yani hatalı veri girip 0 ve altına düşürdüğümü düşünüp tekrar sildiğimde beyaz olmuyor

 

[AdemCan]

Sayfada yazdıkça hesaplama yaptırdığınız için mevcut kullandığınız kodu aşağıdaki kod ile değiştiriniz.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim borc As Long, tutar As Long

If Target.Column = 3 Then
    If Target.Value = "" Then Target.Offset(0, 1).Interior.ColorIndex = xlNone
End If

If Intersect(Target, [C12:C100]) Is Nothing And Intersect(Target, [H12:H100]) Is Nothing And Intersect(Target, [M12:M100]) Is Nothing And Intersect(Target, [R12:R100]) Is Nothing And Intersect(Target, [W12:W100]) Is Nothing And Intersect(Target, [AB12:AB100]) Is Nothing And Intersect(Target, [AL12:AL100]) Is Nothing And Intersect(Target, [AQ12:AQ100]) Is Nothing And Intersect(Target, [AV12:AV100]) Is Nothing And Intersect(Target, [BA12:BA100]) Is Nothing And Intersect(Target, [BF12:BF100]) Is Nothing And Intersect(Target, [BK12:BK100]) Is Nothing And Intersect(Target, [BQ12:BQ100]) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target = "" Then: Target.Offset(0, -2) = "": Target.Offset(0, 1) = "": Exit Sub
If Not IsNumeric(Target) Then MsgBox "Sadece sayı girebilirsin": Target = "": Exit Sub
Target.Offset(0, -2) = Target.Row - 11

If Target.Row = 12 Then
borc = Target.Offset(-4, 1): tutar = Target.Value
Target.Offset(0, 1) = borc - tutar
    If borc - tutar <= 0 Then Target.Offset(0, 1).Interior.ColorIndex = 3
Else
borc = Target.Offset(-1, 1): tutar = Target.Value
Target.Offset(0, 1) = borc - tutar
    If borc - tutar <= 0 Then Target.Offset(0, 1).Interior.ColorIndex = 3
End If

End Sub

 

[balanar]

Sayfada yazdıkça hesaplama yaptırdığınız için mevcut kullandığınız kodu aşağıdaki kod ile değiştiriniz.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim borc As Long, tutar As Long

If Target.Column = 3 Then
    If Target.Value = "" Then Target.Offset(0, 1).Interior.ColorIndex = xlNone
End If

If Intersect(Target, [C12:C100]) Is Nothing And Intersect(Target, [H12:H100]) Is Nothing And Intersect(Target, [M12:M100]) Is Nothing And Intersect(Target, [R12:R100]) Is Nothing And Intersect(Target, [W12:W100]) Is Nothing And Intersect(Target, [AB12:AB100]) Is Nothing And Intersect(Target, [AL12:AL100]) Is Nothing And Intersect(Target, [AQ12:AQ100]) Is Nothing And Intersect(Target, [AV12:AV100]) Is Nothing And Intersect(Target, [BA12:BA100]) Is Nothing And Intersect(Target, [BF12:BF100]) Is Nothing And Intersect(Target, [BK12:BK100]) Is Nothing And Intersect(Target, [BQ12:BQ100]) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target = "" Then: Target.Offset(0, -2) = "": Target.Offset(0, 1) = "": Exit Sub
If Not IsNumeric(Target) Then MsgBox "Sadece sayı girebilirsin": Target = "": Exit Sub
Target.Offset(0, -2) = Target.Row - 11

If Target.Row = 12 Then
borc = Target.Offset(-4, 1): tutar = Target.Value
Target.Offset(0, 1) = borc - tutar
    If borc - tutar <= 0 Then Target.Offset(0, 1).Interior.ColorIndex = 3
Else
borc = Target.Offset(-1, 1): tutar = Target.Value
Target.Offset(0, 1) = borc - tutar
    If borc - tutar <= 0 Then Target.Offset(0, 1).Interior.ColorIndex = 3
End If

End Sub

hocam emeğiniz için teşekkür ediyorum istediğim olmuş. Fakat benim eksik anlatımımdan kaynaklı şuanda D sutununda çalışıyor.. Fakat üstte bir kod sekmemiz var. Aynı tablo yapısını yan yana taşıyoruz.

ilk kesinti no 1 tablosu dışında çalışmıyor haliyle buradaki tüm tablolar için bir çözüm üretiebilir misiniz


örnek olarak H12'ye 7000 yazın kırmızıya dönecek sonra o 7000'i silin tekrar beyaz olmuyor.

Ama aynı işlemi C sutununda yapınca D sutununda beyaza dönüyor burası doğru.. Diğerleri içinde yapabilsek çözülmüş olacak

 

[AdemCan]

Merhaba, paylaştığım kod içerisinde bulunan aşağıdaki bölümü

If Target.Column = 3 Then
    If Target.Value = "" Then Target.Offset(0, 1).Interior.ColorIndex = xlNone
End If

bu kodlar ile değiştiriniz.

For i = 3 To 113 Step 5
    If Target.Column = i Then
        If Target.Value = "" Then Target.Offset(0, 1).Interior.ColorIndex = xlNone
    End If
Next i