Çözüldü eksiye düşen kısmı belirleme

şöyle çalışma yapmaya çalıştım ama formülde hata verdi o yüzden doğru çalışıyormu bilemedim
önce buton ile vade tarihlerini sıra hale getirip işlme yapmaya çalıştım

Merhaba.
Alttaki kodu hazırladım ama emin değilim doğrumu.
Kodu aynı sayfada çalıştırın

ilginiz için teşekkür ederim
2nolu mesajda yanlış dosya eklemişim kusura bakmayın
vermiş olduğunuz kod ile aynı sonucu buldu
inceledeikten sonra tekrar dönüş yapayım

...

Öncekinde mesajımı silemediğim için ... yazmıştım.

Son dosyanızda formülyazmışsınız ondan anlamıyorum.
Ama kodu çakıştırınca nerde eksi olduysa o satıra gider.
Sadece b2 ve b3 değiştirin.

Az biraz ekleme yaptım gifteki gibi renk ve rakam yazdırmayı.
Neyse benden bu kadar pazartesine kadar müsait olmayacağım.
Kolay gelsin.

Aslında şöylede eklenebilinir son dosya ve koda.
Tarihler seçilince F sütununa ödenmeyenler için koddaki değer yazan sonuç yazdırılır bun içn tek satır kod yeterli ama pc açamam dediğim zamana kadar.
Değerler f stununa yazdırılınca zaten belli olur sonuçlar.F ye yazdırılsın derseniz son dosyadaki kodu buraya ekleyin ayarlayayım mobilden.

Refaz' Alıntı:

Az biraz ekleme yaptım gifteki gibi renk ve rakam yazdırmayı.
Neyse benden bu kadar pazartesine kadar müsait olmayacağım.
Kolay gelsin.

Ekli dosyayı görüntüle 9689

Genişletmek için tıkla...

merhabalar
dosyayı indirdim ancak bu hali ilesöyle hata oluşmuş
şuanki hali ile artık 2 tarih arası filtreleme yapmıyor

Refaz' Alıntı:

Aslında şöylede eklenebilinir son dosya ve koda.
Tarihler seçilince F sütununa ödenmeyenler için koddaki değer yazan sonuç yazdırılır bun içn tek satır kod yeterli ama pc açamam dediğim zamana kadar.
Değerler f stununa yazdırılınca zaten belli olur sonuçlar.F ye yazdırılsın derseniz son dosyadaki kodu buraya ekleyin ayarlayayım mobilden.

Genişletmek için tıkla...

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B2:B3]) Is Nothing Then Exit Sub

On Error GoTo hata
Dim hcr As Range, deger As Double, son As Long

son = Cells(Rows.Count, "B").End(3).Row
If son < 8 Then Exit Sub
Range("F8:F" & Rows.Count).Clear

Range("B7:B" & son).Sort [B7], , , , , , , xlYes
deger = [E1].Value
For Each hcr In Range("B8:B" & son)
If CLng(CDate(hcr.Value)) >= CLng(CDate([B2].Value)) And CLng(CDate(hcr.Value)) <= CLng(CDate([B3].Value)) Then
If hcr.Offset(, 3).Value = "ödenmedi" And hcr.Offset(, 1).Value > 0 Then deger = deger + hcr.Offset(, 1).Value
If hcr.Offset(, 3).Value = "ödenmedi" And hcr.Offset(, 2).Value > 0 Then deger = deger - hcr.Offset(, 2).Value
If deger < 0 Then MsgBox hcr.Address(0, 0): hcr.Activate: Range("F" & hcr.Row).Value = deger: Range("F" & hcr.Row).Interior.Color = vbRed: Exit For
If hcr.Row > son Then Stop: Exit For
End If
Next
Exit Sub
hata:
MsgBox "Hata var", vbCritical, "Hata"
End Sub

bu 2 tarih arası filtreleme için kullandığım
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B2:B3]) Is Nothing Then Exit Sub
AutoFilterMode = False
trh1 = [B2]
trh2 = [B3]
If trh1 = Empty And trh2 = Empty Then AutoFilterMode = False: Exit Sub
If IsDate(trh1) = False Or IsDate(trh2) = False Then MsgBox "Tarihleri uygun formatta giriniz.", vbInformation, "ExcelCozum.com": Exit Sub
If trh1 > trh2 Then MsgBox "Başlangıç bitişden büyük olamaz.", vbInformation, "ExcelCozum.com": Exit Sub
ss = Cells(Rows.Count, 2).End(xlUp).Row
cr1 = ">=" & CLng(trh1)
cr2 = "<=" & CLng(trh2)
Range("B7:G" & ss).AutoFilter 1, cr1, xlAnd, cr2
End Sub

Zaten son dosyadaki kodlar fitrelemer yapmıyordu.Neyse yatım saat zamanım var yapabilirsem bir bakayım.

Ay kod değişikliği yaptım sizin koduda ekledim.

bunu ekledim sadece önceki koda ve

Heralde yanlış olabilir tahminen belki.

Neyse gene bir sürü mesaj yazdım fazladan
Denersiniz ve sadece kırmızı olan yerdeki rakam olsun derseniz gereksiz yeri silersiniz koddaki.
Olmadı ya pazar gecesi yada pazartesi bakarım abey.Şimdi yolculuğa çıkmam gerek
Kod doğru çalışırsa hızlandırırız sorun olmaz.

Düzeltme:Alttaki koddaki Stop: yer silinmeli unutulmuş. 07.07.2022
If hcr.Row > son Then Stop: Exit For

elinize sağlık hayırlı yolcukuklar ben kontrolleri yapar bilgi veririm teşekkür ederim

Refaz' Alıntı:

If CLng(CDate(hcr.Value)) >= CLng(CDate([B2].Value)) And CLng(CDate(hcr.Value)) <= CLng(CDate([B3].Value)) Then

Genişletmek için tıkla...

Sağolun.Alamsnyadan hollandaya 3 saatlik araba yolculuğu başarı ile tamamlandı
Filtrelendiği içn yukardakine ve end alttaki koda gerek yok aslında yolda aklıma geldi.

Birde koddaki ilk iki yerdeki alttaki kodları silerseniz sadece eksi olanları F ye yazar.

Neyse siz denersiniz.

Range("F" & hcr.Row).Value = deger

Yolculuğunuz için geçmiş olsun diyelim
siz almanyadan fransaya vardınız benim sayfada düzenleme yapınca formülleri yerine oturtamadım
malesef insan nasıl yapacağını bilmeyince deneme yanılma ile uğraşıp duruyor
gün içinde inş bitirmiş olurum ama düzgün çalışıyor gibi gözüküyor
elinize sağlık