FATURA KAPAMA-Kesintili ve yuvarlamalı

[Mertsan]

Merhaba Arkadaşlar,

Fatura kapama excel de popüler konulardan biri ve çokca çalışma yapılmış durumlar var. Mevcutlar aşağıda belirttiğim konuda ihtiyacımı karşılamıyor.

Devlet kurumlarına yapılan satışlarda kanuni kesintili ödeme yapıldığı için cari hesaptaki fatura veya fatura guruplarını karşılayan ödeme+kanuni kesinti mahsuplarını takip etmek istiyorum.

Ekte örnek dosya var.
Ödemeler birkaç şekilde gerçekleşiyor.
-Bir faturayı karşılayan bir ödeme+bir kanuni kesinti
-Birden fazla faturayı karşılayan bir ödeme+bir kanuni kesinti
-Birden fazla faturayı karşılayan birden fazla ödeme+birden fazla kanuni kesinti

İstediğim ise hangi faturayı hangi ödeme+kanuni kesinti satırları karşılıyorsa hepsine aynı numarayı vermesi.

Cari hesabın işlemi çözmeye yardımcı olacak özelliği ise birden fazla fatura ödemesi olduğunda bu faturalar ardışık olanlardan seçilerek ödeniyor. Genelde en baş tarihten itibaren sıra ile tek veya birkaç fatura gurubu olarak ödeniyor.

Örnekte son ödemede görüldüğü gibi 1 kuruşluk hata ile ödemeler yapıldığında mümkünse bu durumu ayarlayabileceğimiz bir hassasiyet değeri girerek örneğin "4 kuruş hata payı ile eşleştir gibi" girebilirsek faturaların daha fazlasını kapsayabileceğiz.

Yardımcı olabilecek değerli arkadaşlarıma şimdiden teşekkür ediyorum.

 

[Mertsan]

Arkadaşlar konu hakkında bir algoritma oluşturulabilir mi acaba?

 

[halit3]

Sıralamanız ardışık düzenli olmalı bu kodu bir numaralı mesajdaki dosyanızda deneyin.

kod G,H,I,J,K sütünlarına sonuçları çıkartıyor.

not artı 0.05 eksi 0.05 farkları için duyarlıdır.

Sub Gruplandir()

'GoTo atla4
Dim sut4, sut2, sat1
Dim deg1, deg2, say1, say2

son1 = Cells(Rows.Count, "a").End(3).Row
ReDim ara1(son1): ReDim ara2(son1): ReDim ara3(son1):

Range("g2:k" & Rows.Count).ClearContents

sut4 = 2
sut2 = 2
say4 = 1
say3 = 1
sat5 = 1

For j = sut4 To Cells(Rows.Count, "d").End(3).Row + 1

deg1 = 0
deg2 = 0

For m = sut4 To Cells(Rows.Count, "d").End(3).Row + 1
deg1 = deg1 + CDbl(Cells(m, "d").Value)

sut4 = m + 1
If deg1 > 0 And sut4 > 0 Then

If Cells(m, "d").Value = "" Then
Cells(m - 1, 8).Value = deg1
sat5 = sat5 + 1

GoTo atla3
End If
Cells(m, 10).Value = say4
End If
'End If
Next m

atla3:

say4 = say4 + 1

Next
atla4:


say1 = 0
say2 = 0

For j = 2 To son1
'If Val(Cells(j, "C")) > 0 Then
say1 = say1 + 1
ara1(say1) = Cells(j, "C")
ara2(say1) = j
'End If
Next j


For j = 2 To Cells(Rows.Count, 8).End(3).Row
If Val(Cells(j, 8)) > 0 Then
say2 = say2 + 1
ara3(say2) = Cells(j, 8)
End If
Next j

sat1 = 1
kat = 1
For r = 1 To say2
aranan3 = ara3(r)

atla1:
sut3 = 0
sut4 = ""
'MsgBox sat1
'MsgBox say1
'MsgBox sat1 & Chr(10) & say1

For i = sat1 To say1 - 1

If ara1(i) > 0 Then

sut3 = sut3 + CDbl(ara1(i))
sut4 = sut4 & "," & i


ver1 = Round(sut3 + 0.01, 2) * 1
ver2 = Round(sut3 + 0.02, 2) * 1
ver3 = Round(sut3 + 0.03, 2) * 1
ver4 = Round(sut3 + 0.04, 2) * 1
ver5 = Round(sut3 + 0.05, 2) * 1

ver6 = Round(sut3 - 0.01, 2) * 1
ver7 = Round(sut3 - 0.02, 2) * 1
ver8 = Round(sut3 - 0.03, 2) * 1
ver9 = Round(sut3 - 0.04, 2) * 1
ver10 = Round(sut3 - 0.05, 2) * 1


'MsgBox ver1 & Chr(10) & ver2 & Chr(10) & ver3 & Chr(10) & ver4 & Chr(10) & ver5


If aranan3 = sut3 Or aranan3 = ver1 Or aranan3 = ver2 Or aranan3 = ver3 Or aranan3 = ver4 Or aranan3 = ver5 Or aranan3 = ver6 Or aranan3 = ver7 Or aranan3 = ver8 Or aranan3 = ver9 Or aranan3 = ver10 Then
'MsgBox aranan3 & Chr(10) & sut3
Cells(ara2(i), 7).Value = sut3


deg7 = Split(sut4, ",")
If UBound(deg7) > 0 Then
For t = 1 To UBound(deg7)

Cells(deg7(t) + 1, 9).Value = kat
Next t
End If



'Cells(ara2(i), 12).Value = sut4
kat = kat + 1
'MsgBox i
sat1 = i + 1
GoTo atla2
End If


If aranan3 < sut3 Then 'Or aranan3 < ver1 Or aranan3 < ver2 Or aranan3 < ver3 Or aranan3 < ver4 Or aranan3 < ver5 Then
sat1 = i
GoTo atla1
End If

End If
Next i
atla2:
Next r



For j = 2 To Cells(Rows.Count, "b").End(3).Row
If Val(Cells(j, 9).Value + Cells(j, 10).Value) <= 0 Then
Cells(j, 11).Value = "ÖDENMEYEN"

End If
Next j


MsgBox "İşleminiz tamamlanmıştır.", vbInformation, " Sonuç Penceresi"

End Sub

 

[Mertsan]

Halit bey Çalışmanız için çok teşekkür ederim.

Kodu uyguladığımda mevcut örnekte güzel çalışıyor. Farklı sütunlarda gruplandırmalar halinde fatura ve tahsilat toplamlarını gösteriyor olması da güzel bir yorum oldu.

Ekstreyi biraz daha uzattığımda kod sonsuz döngüye girdi. Biryerde tıkanmaya neden olan bir durum var galiba. Eklediğim satırlarda ödenen faturaların ardışık olarak gitmesine dikkat ettim.

Dosyanın kod eklenmiş halini ekte yolladım.
İnceleyebilirseniz memnun olurum.
Saygılarımla.

 

[halit3]

Ekli dosyada önce (Düğme 1) sonra (Düğme 2) komutlarını sırası ile çalıştır.

 

[Mertsan]

Halit bey, çalışma bu şekliyle tamamdır.

Borç/Alacak toplam karşılaştırma sütunu da destekleyici olmuş.

Ellerinize sağlık. Ufuk açıcı bir kodlama oldu. Farklı şekillerde geliştirmeye de çok uygun.

Saygılarımla.
Mert.

 

[halit3]

Halit bey, çalışma bu şekliyle tamamdır.

Borç/Alacak toplam karşılaştırma sütunu da destekleyici olmuş.

Ellerinize sağlık. Ufuk açıcı bir kodlama oldu. Farklı şekillerde geliştirmeye de çok uygun.

Saygılarımla.
Mert.

Teşekkürler iyi çalışmalar.