Yardım Maliyet hesaplatmada birim maliyeti ondalık olarak gelmiyor

sukrualtunkuyu

Yeni Üye
Katılım
27 Şub 2019
Mesajlar
2
Puanları
1
Yaş
27
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.

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
 

Ekli dosyalar

Moderatör tarafında düzenlendi:

Ömer BARAN

Uzman
Katılım
17 Ağu 2018
Mesajlar
39
Puanları
8
Konum
Ankara, İstanbul
Ad Soyad
Ömer BARAN
Merhaba.
Sorun, değişken türleriyle ilgili olabilir.

KTF'yi yazan olmadığımıza göre, örnek belge üzerinden uygulamasını görmek gerekir.

Mevcut KTF kodları ve bu KTF'nin kullanıldığı hesaplama örneği olan ve olması gereken sonucun da haricen hesaplanarak belgeye yazıldığı
bir örnek belge yüklerseniz daha hızlı sonuca ulaşabilirsiniz diye düşünüyorum.
.
 

sukrualtunkuyu

Yeni Üye
Katılım
27 Şub 2019
Mesajlar
2
Puanları
1
Yaş
27
Konum
Bursa
Ad Soyad
Şükrü Altunkuyu
ömer bey,
ekte bir dosya gönderiyorum ve yapmak istediklerimi de açıklamaya çalıştım. yardımcı olursanız çok sevinirim. teşekkürler.
 

Ekli dosyalar

Üst Alt