Kasa açıklarını tip box ile tamamlama

sarigozoglu

Altın Üye
Katılım
26 Eylül 2014
Mesajlar
85
Excel Vers. ve Dili
Office 365 TR-32
Altın Üyelik Bitiş Tarihi
06-01-2025
Arkadaşlar merhaba,

İşletmemizde 2 adet kasa ve her kasa önünde tip box kutusu bulunmakta.

Günün sonunda kasalarımızda çıkan açıkları tip boxlar ile tamamlamak istiyoruz.

Bu tamamlama için kurallarımız;

a) 1 nolu kasanın açığı öncelikle 1 nolu tip box'tan, yetmez ise 2 nolu tip box'tan karşılanabilir.
b) 2 nolu kasanın açığı sadece 2 nolu kasadan tamamlanabilir.
c) açık tamamlamada öncelik 1 nolu kasanınındır.
d) 1 nolu kasanın açık tamamlanmasından sonra 2 nolu tipbox'ta para kalmış ise 2 nolu kasanın açığı tamamlanır.

İşlemler sonunda hangi kasadan ne almışız, kasalarda ne kadar kalmış bunu görmeliyiz.

Desteğiniz için şimdiden teşekkür ederim.
 

Ekli dosyalar

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,779
Excel Vers. ve Dili
Microsoft 365 Tr-64
C++:
Sub TipBoxHesapla()
    Dim Wf As WorksheetFunction
    If Range("C" & Rows.Count).End(3).Row < 3 Then Exit Sub
    Set Wf = WorksheetFunction
    Veri = Range("D3:O" & Range("C" & Rows.Count).End(3).Row).Value
    ReDim Liste(1 To UBound(Veri, 1), 1 To UBound(Veri, 2))
    For i = 1 To UBound(Veri, 1)
        Liste(i, 1) = Veri(i, 1)
        Liste(i, 2) = Veri(i, 2)
        Liste(i, 3) = Veri(i, 3)
        Liste(i, 4) = Veri(i, 4)
        Liste(i, 5) = Wf.Min(Liste(i, 1), Liste(i, 3))
        Liste(i, 6) = Wf.Min(Liste(i, 3) + Liste(i, 4) - Liste(i, 5), Liste(i, 2))
        Liste(i, 7) = Liste(i, 5) + Wf.Min(Liste(i, 3) - Liste(i, 5), Liste(i, 2))
        Liste(i, 8) = Liste(i, 5) + Liste(i, 6) - Liste(i, 7)
        Liste(i, 9) = Liste(i, 3) - Liste(i, 7)
        Liste(i, 10) = Liste(i, 4) - Liste(i, 8)
        Liste(i, 11) = Liste(i, 1) - Liste(i, 5)
        Liste(i, 12) = Liste(i, 2) - Liste(i, 6)
    Next i
    Range("D3:O" & Range("C" & Rows.Count).End(3).Row) = Liste
End Sub
 

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
Merhaba.
Alternatif kod.

Kod:
Sub Test()
    Dim Bak As Long
    For Bak = 3 To Cells(Rows.Count, "D").End(xlUp).Row
        Cells(Bak, "H") = WorksheetFunction.Min(Cells(Bak, "D"), Cells(Bak, "F"))
        Cells(Bak, "I") = WorksheetFunction.Min((Cells(Bak, "F") + Cells(Bak, "G")) - Cells(Bak, "H"), Cells(Bak, "E"))
        Cells(Bak, "J") = Cells(Bak, "H") + WorksheetFunction.Min(Cells(Bak, "F") - Cells(Bak, "H"), Cells(Bak, "E"))
        Cells(Bak, "K") = (Cells(Bak, "H") + Cells(Bak, "I")) - Cells(Bak, "J")
        Cells(Bak, "L") = Cells(Bak, "F") - Cells(Bak, "J")
        Cells(Bak, "M") = Cells(Bak, "G") - Cells(Bak, "K")
        Cells(Bak, "N") = Cells(Bak, "D") - Cells(Bak, "H")
        Cells(Bak, "O") = Cells(Bak, "E") - Cells(Bak, "I")
    Next
End Sub
 

sarigozoglu

Altın Üye
Katılım
26 Eylül 2014
Mesajlar
85
Excel Vers. ve Dili
Office 365 TR-32
Altın Üyelik Bitiş Tarihi
06-01-2025
Çok Teşekkür ederim :)
 
Üst