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

Katılım
27 Şub 2019
Mesajlar
1
En İyi Yanıtlar
0
Beğeniler
0
Puanları
1
Yaş
27
Konum
Bursa
Ad Soyad
Şükrü Altunkuyu
#1
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:
Katılım
17 Ağu 2018
Mesajlar
21
En İyi Yanıtlar
5
Beğeniler
10
Puanları
3
Yaş
55
Konum
Ankara, İstanbul
Ad Soyad
Ömer BARAN
#2
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.
.
 
Üst Alt