• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

ödenmeyen faturaların tespiti

Kriter hangi sütunu alacak F mi G mi kısaca ödenip ödenmediğini nasıl anlıyoruz.
 
Deneyiniz.
Kod: 
Sub mv()
Set sh = Sheets("Sayfa1")
For i = 2 To sh.Cells(Rows.Count, "F").End(3).Row
If sh.Cells(i, "F") <> "" Then
sh.Cells(i, "L").Value = sh.Cells(i, "H").Value
sh.Cells(i, "M").Value = sh.Cells(i, "F").Value
End If
Next i
End Sub
 
bir eksiklik var galiba

vardar07' Alıntı:
Deneyiniz.
Kod: 
Sub mv()
Set sh = Sheets("Sayfa1")
For i = 2 To sh.Cells(Rows.Count, "F").End(3).Row
If sh.Cells(i, "F") <> "" Then
sh.Cells(i, "L").Value = sh.Cells(i, "H").Value
sh.Cells(i, "M").Value = sh.Cells(i, "F").Value
End If
Next i
End Sub
Genişletmek için tıkla ...

makro fatura numarasını ve tutarını yan yana getiriyor, ödeme ile ilgili bir işlem yapmıyor.
 
Merhaba.

Sayın vardar'ın müsadeleriyle.

Aşağıdaki kod'u dener misiniz? (kod'u ilgili sayfanın kod böölümüne uygulayın)
.
Kod: 
[B]Sub ODENMEYENLER_BRN()[/B]
On Error Resume Next: ActiveSheet.ShowAllData
Set wf = Application.WorksheetFunction
Columns("L:M").ClearContents
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
For sat = Cells(Rows.Count, 1).End(3).Row To 2 Step -1
    baş = wf.Match(Cells(sat, 3), Range("C:C"), 0): bit = baş + wf.CountIf(Range("C:C"), Cells(sat, 3)) - 1
    bak = wf.Sum(Range("F" & baş & ":F" & bit)) - wf.Sum(Range("G" & baş & ":G" & bit))
    sontsat = Cells(bit + 1, "G").End(3).Row + 1
        For tam = bit To sontsat Step -1
            Cells(tam, "L") = Cells(tam, "H"): Cells(tam, "M") = Cells(tam, "F"): Next
            eski = wf.Sum(Range("F" & baş & ":F" & sontsat - 1)) - wf.Sum(Range("G" & baş & ":G" & sontsat - 1))
            If eski = 0 Then GoTo 10
            For brn = baş To sontsat
                    brnbak = wf.Sum(Range("F" & baş & ":F" & brn)) - wf.Sum(Range("G" & baş & ":G" & brn))
                If brnbak = eski Then
                    günilk = wf.Match(Cells(brn, 2), Range("B" & baş & ":B" & sontsat - 1), 0) + baş - 1
                    For fsat = brn To günilk Step -1
                        If Cells(fsat, "F") > 0 Then
                            f = wf.Sum(Range("F" & fsat & ":F" & brn)) - wf.Sum(Range("G" & fsat & ":G" & brn))
                            Cells(fsat, "L") = Cells(fsat, "H"): Cells(fsat, "M") = f: End If: Next
                If f = brnbak Then GoTo 10
                End If: Next
10:    sat = baş
Next: Range("M2:M" & Cells(Rows.Count, 1).End(3).Row).NumberFormat = "#,##0.00": Columns("L:M").AutoFit
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "İşlem tamamlandı..", vbInformation, "..:: Ö. BARAN ::.."
[B]End Sub[/B]
 
sonuçta hata çıkıyor.

Ömer BARAN' Alıntı:
Merhaba.

Sayın vardar'ın müsadeleriyle.

Aşağıdaki kod'u dener misiniz? (kod'u ilgili sayfanın kod böölümüne uygulayın)
.
Kod: 
[B]Sub ODENMEYENLER_BRN()[/B]
On Error Resume Next: ActiveSheet.ShowAllData
Set wf = Application.WorksheetFunction
Columns("L:M").ClearContents
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
For sat = Cells(Rows.Count, 1).End(3).Row To 2 Step -1
    baş = wf.Match(Cells(sat, 3), Range("C:C"), 0): bit = baş + wf.CountIf(Range("C:C"), Cells(sat, 3)) - 1
    bak = wf.Sum(Range("F" & baş & ":F" & bit)) - wf.Sum(Range("G" & baş & ":G" & bit))
    sontsat = Cells(bit + 1, "G").End(3).Row + 1
        For tam = bit To sontsat Step -1
            Cells(tam, "L") = Cells(tam, "H"): Cells(tam, "M") = Cells(tam, "F"): Next
            eski = wf.Sum(Range("F" & baş & ":F" & sontsat - 1)) - wf.Sum(Range("G" & baş & ":G" & sontsat - 1))
            If eski = 0 Then GoTo 10
            For brn = baş To sontsat
                    brnbak = wf.Sum(Range("F" & baş & ":F" & brn)) - wf.Sum(Range("G" & baş & ":G" & brn))
                If brnbak = eski Then
                    günilk = wf.Match(Cells(brn, 2), Range("B" & baş & ":B" & sontsat - 1), 0) + baş - 1
                    For fsat = brn To günilk Step -1
                        If Cells(fsat, "F") > 0 Then
                            f = wf.Sum(Range("F" & fsat & ":F" & brn)) - wf.Sum(Range("G" & fsat & ":G" & brn))
                            Cells(fsat, "L") = Cells(fsat, "H"): Cells(fsat, "M") = f: End If: Next
                If f = brnbak Then GoTo 10
                End If: Next
10:    sat = baş
Next: Range("M2:M" & Cells(Rows.Count, 1).End(3).Row).NumberFormat = "#,##0.00": Columns("L:M").AutoFit
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "İşlem tamamlandı..", vbInformation, "..:: Ö. BARAN ::.."
[B]End Sub[/B]
Genişletmek için tıkla ...
makroyu uyguladım ama bazı durumda sonucu ulaştım ama eke yüklediğim gibi durum olduğunda hatalı sonuç veriyor. http://s6.dosya.tc/server8/k1778y/ornek2.rar.html
ilginize teşekkürler.
 
Merhaba.

Bir de aşağıdaki kod'u dener misiniz?
İlk örnek dosyanıza göre önceki cevabımdaki kod da aşağıdaki de sonuç alınmasını sağlıyor.

Son eklediğiniz belgede faturası olmayan ödeme var gibi görüyorum (7'nci satırdaki 500,00),
bu durumda ne yapılacağı çok net değil doğrusu.

Aslına bakarsanız mantığın şu şekilde olması lazım;
-- faturalar borç kaydedilir,
-- ödemeler, o ana kadar oluşan faturalardan ödenmemiş ilkine ait olmalıdır (FİFO gibi).

Ama ben, isteğinizin "tarih / müşteri kodu kriterine göre işlem yapılması" şeklinde olduğunu düşünerek
kod oluşturdum (hem gönderdiğim ilk kod, hem de aşağıdaki kod bu şekilde)

İstediğiniz sonucu alamazsanız; sadece sonuç alamadığınız satırları değil,
sonuç alamadığınız belgedeki tüm listeyi ekleyiniz.
.
Kod: 
[B]Sub ODENMEYENLER_BRN2()[/B]
On Error Resume Next: ActiveSheet.ShowAllData
Set wf = Application.WorksheetFunction
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
Columns("L:N").Delete: Columns("F:G").Copy [M1]
For sat = Cells(Rows.Count, 1).End(3).Row To 2 Step -1
    If Cells(sat, 3) <> Cells(sat + 1, 3) Then
    kodson = sat: kodilk = wf.Match(Cells(sat, 3), Range("C:C"), 0)
        For satt = kodilk To kodson
        If Cells(satt, "N") > 0 Then
            If wf.CountIf(Range("M" & kodilk & ":M" & satt), Cells(satt, "N")) > 0 Then
                hedefsat = wf.Match(Cells(satt, "N"), Range("M" & kodilk & ":M" & satt), 0) + kodilk - 1
                Cells(hedefsat, "M") = "": Cells(satt, "N") = ""
            End If: End If: Next: End If: Next
For sat = Cells(Rows.Count, 1).End(3).Row + 1 To 2 Step -1
    If Cells(sat, "N") > 0 Then
        For satt = sat To 2 Step -1
            If Cells(satt, 2) <> Cells(sat - 1, 2) Then
                borc = wf.Sum(Range("M" & satt + 1 & ":M" & sat))
                alacak = wf.Sum(Range("N" & satt + 1 & ":N" & sat))
                If borc = alacak Then
                    Range("N" & satt + 1 & ":M" & sat) = ""
                ElseIf borc > alacak Then
                    Range("M" & satt + 1) = borc - alacak: Range("N" & satt + 1 & ":N" & sat) = ""
                    Exit For: End If: End If: Next: End If: Next
For sat = 2 To Cells(Rows.Count, 1).End(3).Row
    If Cells(sat, "M") > 0 Then Cells(sat, "L") = Cells(sat, "H")
Next: Columns("N").Delete
Range("A1:M1").AutoFilter: Range("A1:M1").AutoFilter
ActiveSheet.Range("$A$1:$M$717").AutoFilter Field:=12, Criteria1:="<>"
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "İşlem tamamlandı..", vbInformation, "..:: Ö. BARAN ::.."
[B]End Sub[/B]
 
igultekin2000' Alıntı:
makro fatura numarasını ve tutarını yan yana getiriyor, ödeme ile ilgili bir işlem yapmıyor.
Genişletmek için tıkla ...

Dosyanızdaki açıklamanız: "Fatura ve ödemelerin programdan çıkmış hali. Benim yapak istediğim ödemesi yapılmamış faturaları makro ile tespit etmek. Ödenmeyen faturaların numarasını ve tutarın L ve M sütununa yazdırmak." yukardaki isteğiniz sonradan çıktı galiba. Ödeme ile ilgili nasıl bir işlem yapacak. Sizin ne yapmak istediğinizi bilmediğimiz için sizin isteklerinizi net ve eksiksiz yazmanız lazım. Mesela Ftno:50620 Tutar: 800,00 Ödeme: ???? ne olacak.
 
ilave açıklama

vardar07' Alıntı:
Dosyanızdaki açıklamanız: "Fatura ve ödemelerin programdan çıkmış hali. Benim yapak istediğim ödemesi yapılmamış faturaları makro ile tespit etmek. Ödenmeyen faturaların numarasını ve tutarın L ve M sütununa yazdırmak." yukardaki isteğiniz sonradan çıktı galiba. Ödeme ile ilgili nasıl bir işlem yapacak. Sizin ne yapmak istediğinizi bilmediğimiz için sizin isteklerinizi net ve eksiksiz yazmanız lazım. Mesela Ftno:50620 Tutar: 800,00 Ödeme: ???? ne olacak.
Genişletmek için tıkla ...

http://s9.dosya.tc/server2/cduz73/ornek.rar.html

evet konu zihnimde olduğu için ifade biraz eksik oluyor. kısaca izah edecek olursam. liste datasoft programından çıktığı haliyle, C Sütunu müşterinin hesap kodunu, F sütunu ise o müşteriye kesilen fatura tutarını, H sütunu ise ilgili faturanın numarasını gösteriyor. G sütunu ise o firmadan yapılan tahsilatı gösteriyor. yapılan ödemelerin ilk faturaya sayılmasını sağlayarak aşağı doğru ödenmeyen faturaları tespit etmek. formda yaşlandırma şeklinde örnek buldum ama o da mesela fatura tutarı 800 , ödeme 900 yapıldığı zaman hata veriyor.
 
teşekkürler

Ömer BARAN' Alıntı:
Merhaba.

Bir de aşağıdaki kod'u dener misiniz?
İlk örnek dosyanıza göre önceki cevabımdaki kod da aşağıdaki de sonuç alınmasını sağlıyor.

Son eklediğiniz belgede faturası olmayan ödeme var gibi görüyorum (7'nci satırdaki 500,00),
bu durumda ne yapılacağı çok net değil doğrusu.

Aslına bakarsanız mantığın şu şekilde olması lazım;
-- faturalar borç kaydedilir,
-- ödemeler, o ana kadar oluşan faturalardan ödenmemiş ilkine ait olmalıdır (FİFO gibi).

Ama ben, isteğinizin "tarih / müşteri kodu kriterine göre işlem yapılması" şeklinde olduğunu düşünerek
kod oluşturdum (hem gönderdiğim ilk kod, hem de aşağıdaki kod bu şekilde)

İstediğiniz sonucu alamazsanız; sadece sonuç alamadığınız satırları değil,
sonuç alamadığınız belgedeki tüm listeyi ekleyiniz.
.
Kod: 
[B]Sub ODENMEYENLER_BRN2()[/B]
On Error Resume Next: ActiveSheet.ShowAllData
Set wf = Application.WorksheetFunction
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
Columns("L:N").Delete: Columns("F:G").Copy [M1]
For sat = Cells(Rows.Count, 1).End(3).Row To 2 Step -1
    If Cells(sat, 3) <> Cells(sat + 1, 3) Then
    kodson = sat: kodilk = wf.Match(Cells(sat, 3), Range("C:C"), 0)
        For satt = kodilk To kodson
        If Cells(satt, "N") > 0 Then
            If wf.CountIf(Range("M" & kodilk & ":M" & satt), Cells(satt, "N")) > 0 Then
                hedefsat = wf.Match(Cells(satt, "N"), Range("M" & kodilk & ":M" & satt), 0) + kodilk - 1
                Cells(hedefsat, "M") = "": Cells(satt, "N") = ""
            End If: End If: Next: End If: Next
For sat = Cells(Rows.Count, 1).End(3).Row + 1 To 2 Step -1
    If Cells(sat, "N") > 0 Then
        For satt = sat To 2 Step -1
            If Cells(satt, 2) <> Cells(sat - 1, 2) Then
                borc = wf.Sum(Range("M" & satt + 1 & ":M" & sat))
                alacak = wf.Sum(Range("N" & satt + 1 & ":N" & sat))
                If borc = alacak Then
                    Range("N" & satt + 1 & ":M" & sat) = ""
                ElseIf borc > alacak Then
                    Range("M" & satt + 1) = borc - alacak: Range("N" & satt + 1 & ":N" & sat) = ""
                    Exit For: End If: End If: Next: End If: Next
For sat = 2 To Cells(Rows.Count, 1).End(3).Row
    If Cells(sat, "M") > 0 Then Cells(sat, "L") = Cells(sat, "H")
Next: Columns("N").Delete
Range("A1:M1").AutoFilter: Range("A1:M1").AutoFilter
ActiveSheet.Range("$A$1:$M$717").AutoFilter Field:=12, Criteria1:="<>"
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "İşlem tamamlandı..", vbInformation, "..:: Ö. BARAN ::.."
[B]End Sub[/B]
Genişletmek için tıkla ...
Baran Bey bu şekilde kullanabiliyorum. başka firmalara da uyguladım. çalışıyor, sadece fatura borcundan dolayı fazla ödeme olursa fazla ödemeyi sonraki faturalardan düşmüyor. o yüzden faturaya göre sıralama yapıp ödemeleri sona aldığımda sorunsuz çalışıyor. ilginize teşekkürler.
 
Tekrar merhaba.

Ekteki belgede yer alan kod istediğinizi yapması lazım.
(Sıralama filan yapmanıza lüzum yok)

Diğer verileriniz üzerinden denemeler yapınız.
.
 

Ekli dosyalar

Ömer BARAN' Alıntı:
Tekrar merhaba.

Ekteki belgede yer alan kod istediğinizi yapması lazım.
(Sıralama filan yapmanıza lüzum yok)

Diğer verileriniz üzerinden denemeler yapınız.
.
Genişletmek için tıkla ...

Ömer bey bu tabloyu makro yerine formülle yapma imkanı var mı? Bir de yeni bir sutün oluşturmak yerine tablo içinde var olan bir sutün da işlem yapılması mümkün mü?

Düzeltme.
Bakiyeyi ve kapanan tutarı makro ile çalışması mümkün mü?
 

Ekli dosyalar

Son düzenleme:
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst