• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

fonkisonların formulü

  • Konbuyu başlatan Konbuyu başlatan MENNES
  • Başlangıç tarihi Başlangıç tarihi
Katılım
2 Kasım 2007
Mesajlar
53
Excel Vers. ve Dili
exel 2003
arkadaşlar merhaba,
aşağıdaki fonksiyonların formul olarak excel sayfasında nasıl bir formul ile kullanabileceğini ögrenmek mümkün müdür? bu fonksiyon ing. olarak yazılmış, karekter yada sözcük değişikliği yapmak gerekir mi kullanabilmek için.
teşekkürler.

Public Function FIFOVal(rPurchase As Range, _
rSales As Range, rUnits As Range) As Double

Dim dUnitsLeft As Double
Dim dValue As Double
Dim lCurrRow As Long
Dim aBuckets As Variant
Dim dCurrDed As Double

dUnitsLeft = rUnits.Value

aBuckets = FillBuckets(rPurchase, rSales)

lCurrRow = LBound(aBuckets, 1)

Do While dUnitsLeft > 0
dCurrDed = Application.Min(aBuckets(lCurrRow, 1), dUnitsLeft)
dUnitsLeft = dUnitsLeft - dCurrDed
dValue = dValue + (dCurrDed * aBuckets(lCurrRow, 2))
lCurrRow = lCurrRow + 1
Loop

FIFOVal = dValue

End Function

Public Function FIFOBal(rPurchase As Range, _
rSales As Range, rPrice As Range) As Double

Dim aBuckets As Variant
Dim lCurrRow As Long
Dim dTotal As Double

aBuckets = FillBuckets(rPurchase, rSales)

For lCurrRow = LBound(aBuckets, 1) To UBound(aBuckets, 1)
If aBuckets(lCurrRow, 2) = rPrice.Value Then
dTotal = dTotal + aBuckets(lCurrRow, 1)
End If
Next lCurrRow

FIFOBal = dTotal

End Function

Private Function FillBuckets(rPurchase As Range, _
rSales As Range) As Variant

Dim cell As Range
Dim dPrevSls As Double
Dim dCurrDed As Double
Dim lCurrRow As Long
Dim aBuckets() As Double

ReDim aBuckets(1 To rPurchase.Rows.Count, 1 To 2)
lCurrRow = LBound(aBuckets, 1)

For Each cell In rPurchase.Columns(1).Cells
aBuckets(lCurrRow, 1) = cell.Value
aBuckets(lCurrRow, 2) = cell.Offset(0, 1).Value
lCurrRow = lCurrRow + 1
Next cell

dPrevSls = Application.Sum(rSales)
lCurrRow = LBound(aBuckets, 1)

Do While dPrevSls > 0
dCurrDed = Application.Min(aBuckets(lCurrRow, 1), dPrevSls)
aBuckets(lCurrRow, 1) = aBuckets(lCurrRow, 1) - dCurrDed
dPrevSls = dPrevSls - dCurrDed
lCurrRow = lCurrRow + 1
Loop

FillBuckets = aBuckets

End Function
 
Geri
Üst