sukrualtunkuyu
Yeni Üye
- Katılım
- 27 Şub 2019
- Mesajlar
- 2
- En iyi yanıt
- 0
- Puanları
- 1
- Yaş
- 32
- Konum
- Bursa
- Ad Soyad
- Şükrü Altunkuyu
Merhaba Arkadaşlar,
Ekte FİFO (ilk giren ilk çıkar) yöntemini kullanmak istediğim bir tablo bulunmaktadır. Vba kodlamasında birim fiyatı virgülün solundaki rakamları baz alarak yapmaktadır. Örneğim birim fiyatı 2,778 ise bunu 2 olarak hesaplamaktadır. birim fiyatı ondalıklı görmesi için nasıl bir çözüm üretebiliriz.
Ekte FİFO (ilk giren ilk çıkar) yöntemini kullanmak istediğim bir tablo bulunmaktadır. Vba kodlamasında birim fiyatı virgülün solundaki rakamları baz alarak yapmaktadır. Örneğim birim fiyatı 2,778 ise bunu 2 olarak hesaplamaktadır. birim fiyatı ondalıklı görmesi için nasıl bir çözüm üretebiliriz.
Kod:
Function fifoval(q As Range, Optional details As String) As Variant
Application.Volatile (True)
Dim i As Integer
Dim qstr As String
Dim pstr As String
Dim cqty As Integer
Dim prc As Double
Dim qty As Integer
Dim ctr As Integer
Dim dstr As String
Dim amt As Double
'Stop
For i = 2 To q.Row - 1
If Cells(i, 1) = Cells(q.Row, 1) Then
Select Case Cells(i, 2)
Case "GİRİŞ"
qstr = qstr & Cells(i, 4) & ","
pstr = pstr & Cells(i, 5) & ","
Case "ÇIKIŞ"
qty = Cells(i, 4)
Do While qty > 0
cqty = Val(qstr)
If cqty = 0 Then
fifoval = "Not enough balance"
Exit Function
End If
Select Case True
Case cqty = qty
qstr = Replace(qstr, cqty & ",", "", , 1)
pstr = Replace(pstr, Val(pstr) & ",", "", , 1)
qty = qty - cqty
Case cqty > qty
qstr = Replace(qstr, cqty, cqty - qty, , 1)
qty = 0
Case cqty < qty
qstr = Replace(qstr, cqty & ",", "", , 1)
pstr = Replace(pstr, Val(pstr) & ",", "", , 1)
qty = qty - cqty
Case cqty = 0
fifoval = "Not enough balance"
Exit Function
End Select
ctr = ctr + 1
If ctr > 1000 Then End: Stop
Loop
End Select
End If
Next i
qty = Cells(q.Row, 4)
Do While qty > 0
cqty = Val(qstr)
If cqty = 0 Then
fifoval = "Not enough balance"
Exit Function
End If
prc = Val(pstr)
Select Case True
Case cqty = qty
dstr = dstr & IIf(dstr = "", "", " + ") & qty & " * " & prc
amt = amt + qty * prc
qstr = Replace(qstr, cqty & ",", "", , 1)
pstr = Replace(pstr, Val(pstr) & ",", "", , 1)
qty = qty - cqty
Case cqty > qty
dstr = dstr & IIf(dstr = "", "", " + ") & qty & " * " & prc
amt = amt + qty * prc
qstr = Replace(qstr, cqty, cqty - qty, , 1)
qty = 0
Case cqty < qty
dstr = dstr & IIf(dstr = "", "", " + ") & cqty & " * " & prc
amt = amt + cqty * prc
qstr = Replace(qstr, cqty & ",", "", , 1)
pstr = Replace(pstr, Val(pstr) & ",", "", , 1)
qty = qty - cqty
End Select
ctr = ctr + 1
If ctr > 1000 Then End: Stop
Loop
If details = "" Then
fifoval = amt
Else
fifoval = dstr
End If
End Function
Moderatör tarafında düzenlendi: