excelde fark bulma

[veysel.çetinkaya]

iyi akşamlar basit bir excel programı hazırlamaya çalışıyorum. Örneğin f5 sütununda ödemem gereken borçlarım var .G5 ,H5,I5 ,J5 i toplayıp K 5 e kaydediyor. Benim yapmak istediğim ise G5 ,H5,I5 ,J5 i toplayıp K 5 e kaydedip F5 deki rakam F 6 dan büyük ise F 6 daki rakam dan o miktarı düşürmesi ( buradaki örnekte ben bu ay 10000 tl. ödedi ise 10000-9454 =546 lirayı F6 dan düşürsün böyle bi şey imkanımız varmı https://www.dosya.tc/server25/btf3c8/excell.xlsx.html

 

[Ömer]

Merhaba,

Çalıştığınız sayfanın kod bölümüne kopyalayın.

Private Sub Worksheet_Calculate()

    Dim i As Long, a As Byte, b As Double, c
   
    For i = 5 To Cells(Rows.Count, "F").End(xlUp).Row
        If Cells(i, "F") < Cells(i, "K") Then
            b = Cells(i, "F") - Cells(i, "K")
            a = InStr(Cells(i + 1, "F").Formula, b)
            If a = 0 Then
                c = Split(Cells(i + 1, "F").Formula, "-")(0)
                Cells(i + 1, "F").Formula = "=" & Replace(c, "=", "") & b
            End If
        End If
    Next i

End Sub

 

[veysel.çetinkaya]

Merhaba,

Çalıştığınız sayfanın kod bölümüne kopyalayın.

Private Sub Worksheet_Calculate()

    Dim i As Long, a As Byte, b As Double, c
  
    For i = 5 To Cells(Rows.Count, "F").End(xlUp).Row
        If Cells(i, "F") < Cells(i, "K") Then
            b = Cells(i, "F") - Cells(i, "K")
            a = InStr(Cells(i + 1, "F").Formula, b)
            If a = 0 Then
                c = Split(Cells(i + 1, "F").Formula, "-")(0)
                Cells(i + 1, "F").Formula = "=" & Replace(c, "=", "") & b
            End If
        End If
    Next i

End Sub

Çok sağolun Allah razı olsun .

 

[mcetinkaya65]

Merhaba,

Çalıştığınız sayfanın kod bölümüne kopyalayın.

Private Sub Worksheet_Calculate()

    Dim i As Long, a As Byte, b As Double, c
  
    For i = 5 To Cells(Rows.Count, "F").End(xlUp).Row
        If Cells(i, "F") < Cells(i, "K") Then
            b = Cells(i, "F") - Cells(i, "K")
            a = InStr(Cells(i + 1, "F").Formula, b)
            If a = 0 Then
                c = Split(Cells(i + 1, "F").Formula, "-")(0)
                Cells(i + 1, "F").Formula = "=" & Replace(c, "=", "") & b
            End If
        End If
    Next i

End Sub

Selamün aleyküm.
Üstad yukardaki Makro 48. satıra kadar çalışıyor sonrası işlem yapmıyor. Gönderdiğim ekteki dosyada sarı renkle hücreyi seçtim.
Saygılarımla