Sayı değerini negatif yapma

[Necdet]

Merhaba,

Böylemi istiyorsunuz kodları?

Sub Eksi()
    
    Dim i   As Long
    Dim Adt As Integer
    
    Application.ScreenUpdating = False
    
    For i = 2 To Cells(Rows.Count, "A").End(3).Row
        If Cells(i, "E") = "B" Then
            Cells(i, "D") = Cells(i, "D") * -1
            Adt = Adt + 1
        End If
        If Cells(i, "E") = "A" Then
            Cells(i, "F") = Cells(i, "F") * -1
            Adt = Adt + 1
        End If
    Next i
    
    Application.ScreenUpdating = True
    
    If Adt = 0 Then
        MsgBox "DÜZELTİLECEK DEĞERE RASTLANMAMIŞTIR...."
    Else
        MsgBox Adt & " Adet Düzeltme Yapılmıştır...:"
    End If
    
End Sub

 

[rtk19641990]

Teşekkür ederim. Saygılar

 

[rtk19641990]

Bir ricam daha olabilir mi? işlem yapılan hücreler renklendirilebilir mi? Yani kriteri sağlayan hücreler renkli olabilir mi? Ekte negatif değerleri kırmızı ile işaretledim. Bu hücreler ben makroyu çalıştırınca otomatik renklenecek.
Teşekkürler.

 

[rtk19641990]

Hallettim teşekkürler.

 

[Necdet]

Hallettim teşekkürler.

Nasıl hallettiğinizi de paylaşırsanız, bu konuyu inceleyen arkadaşlar için de yararlı olur diye düşünüyorum.

 

[rtk19641990]

Aşağıdaki şekilde hallettim. Teşekkürler uyarınız için
Sub Eksi()

Dim i As Long
Dim Adt As Integer

Application.ScreenUpdating = False

For i = 2 To Cells(Rows.Count, "A").End(3).Row
If Cells(i, "H") = "A" Then
Cells(i, "G") = Cells(i, "G") * -1
Cells(i, "G").Font.Color = vbRed
Adt = Adt + 1
End If
If Cells(i, "F") = "B" Then
Cells(i, "E") = Cells(i, "E") * -1
Cells(i, "E").Font.Color = vbRed
Adt = Adt + 1
End If
Next i

Application.ScreenUpdating = True

If Adt = 0 Then
MsgBox "DÜZELTİLECEK DEĞERE RASTLANMAMIŞTIR...."
Else
MsgBox Adt & " ADET DÜZELTME YAPILMIŞTIR...:"
End If

End Sub