VBA - USER DEFINED FUNCTIONS

BETRIEBSWIRTSCHAFTSLEHRE ALLGEMEIN

Public Function EndKapital(Kapital, Zins, Laufzeit)
EndKapital = Kapital * (1 + Zins) ^ Laufzeit
End Function

Public Function Gewinn(Stück, Preis, Kosten)
Gewinn = Stück * Preis - Stück * Kosten
End Function

Public Function Provision3(VerkaufteAktien, PreisProAktie)
VKPreis = VerkaufteAktien * PreisProAktie
If VKPreis < 15000 Then
    Provision3 = 25 + 0.3 * VerkaufteAktien
Else
    Provision3 = 25 + 0.9 * VerkaufteAktien
End If
End Function

Public Function Provision2(VerkaufteAktien, PreisProAktie)
Gesamtpreis = VerkaufteAktien * PreisProAktie
If Gesamtpreis > 100000 Then
    Provision2 = Gesamtpreis * 0.05
ElseIf Gesamtpreis < 200000 Then
    Provision2 = Gesamtpreis * 0.07
Else
    Provision2 = Gesamtpreis * 0.09
End If
End Function

Public Function Jahresbonus(Tätigkeit, Gehalt, Multiplikator)
Select Case Tätigkeit
    Case 1
        Jahresbonus = Gehalt * 0.1 * Multiplikator
    Case 2
        Jahresbonus = Gehalt * 0.09 * Multiplikator
    Case 3
        Jahresbonus = Gehalt * 0.07 * Multiplikator
    Case 4, 5
        Jahresbonus = Gehalt * 0.05 * Multiplikator
    Case 6 To 8
        Jahresbonus = Gehalt * 0.03 * Multiplikator
    Case Is > 9
        Jahresbonus = 100
    Case Else
        Jahresbonus = 0
End Select
End Function

Public Function Provision6(Umsatz As Single) As Single
Select Case Umsatz
    Case Is >= 1000000
        Provision6 = Umsatz * 0.02
    Case Is >= 500000
        Provision6 = Umsatz * 0.015
    Case Is >= 0
        Provision6 = Umsatz * 0.01
    Case Else
        Provision6 = 0
End Select
End Function

Public Function Rabatt(Preis, Stück)
' ermittelt aus Preis und Stückzahl den Endpreis
On Error Resume Next
If TypeName(Preis) = "Range" Then
If Preis.Count > 1 Then Rabatt = CVErr(xlErrValue): Exit Function
End If
If TypeName(Stück) = "Range" Then
If Stück.Count > 1 Then Rabatt = CVErr(xlErrValue): Exit Function
End If
If Stück >= 10 Then
    Rabatt = Stück * Preis * 0.95
Else
    Rabatt = Stück * Preis
End If
If Err Then Rabatt = CVErr(xlErrValue)
End Function