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
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

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
 
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
 
Geri
Üst