Thema Datum  Von Nutzer Rating
Antwort
Rot VBA-Problem Schleife
07.11.2007 14:38:49 Tom
NotSolved
08.11.2007 09:51:25 Jerry
NotSolved

Ansicht des Beitrags:
Von:
Tom
Datum:
07.11.2007 14:38:49
Views:
1748
Rating: Antwort:
  Ja
Thema:
VBA-Problem Schleife
Hallo!

Vielleicht kann uns einer von Euch helfen:
wir haben das Problem, dass folgende VBA nicht so funktioniert wie sie soll.
Wir müssen eine Rentenversicherung berechnen, die ersten vier Funktionen klappen einwandfrei. Aber der Monatsbeitrag_netto lässt sich nicht gut an, da verschiebt uns die VBA immer das Rechnungsalter und das Eintrittsalter. Kann uns da vielleicht jemand helfen?

danke im Voraus!



Public Geburtsjahr As Long
Public Zeile As Variant
Public Altersverschiebung As Integer
Public AF As Integer
Public x As Integer
Public y As Integer
Public n As Integer
Public jR As Integer
Public eta As Integer
Public EA As Integer


Public Function Rechnungsalter_Rente(Eintrittsalter As Integer, Geschlecht As String) As Integer

Geburtsjahr = Year(Now) - Eintrittsalter



If Geschlecht = "m" Then

For Zeile = 9 To 34

Select Case Geburtsjahr

Case (Worksheets("Altersverschiebung").Cells(Zeile, 1).Value) To (Worksheets("Altersverschiebung").Cells(Zeile, 2).Value)

Altersverschiebung = Worksheets("Altersverschiebung").Cells(Zeile, 3).Value

End Select

Next Zeile

Rechnungsalter_Rente = Eintrittsalter + Altersverschiebung

ElseIf Geschlecht = "w" Then

For Zeile = 9 To 34

Select Case Geburtsjahr

Case (Worksheets("Altersverschiebung").Cells(Zeile, 5).Value) To (Worksheets("Altersverschiebung").Cells(Zeile, 6).Value)

Altersverschiebung = Worksheets("Altersverschiebung").Cells(Zeile, 7).Value

End Select

Next Zeile

Rechnungsalter_Rente = Eintrittsalter + Altersverschiebung




End If



End Function




Public Function Einmalbetrag_netto(Eintrittsalter As Integer, Geschlecht As String, Aufschubfrist As Integer, jährliche_Rente As Integer, Versicherungsdauer As Integer) As Long

Dim Dx, Dy, Nx, Ny As Range
Set Dx = Range("Dx")
Set Dy = Range("Dy")
Set Nx = Range("Nx")
Set Ny = Range("Ny")


AF = Aufschubfrist
jR = jährliche_Rente
n = Versicherungsdauer

If Geschlecht = "m" Then
x = Rechnungsalter_Rente(Eintrittsalter, "m")

If x + AF + n < 121 Then
Einmalbetrag_netto = (Nx(x + AF).Value - Nx(x + n + AF).Value) / Dx(x).Value * jR

Else

Einmalbetrag_netto = (Nx(x + AF).Value) / Dx(x).Value * jR

End If

ElseIf Geschlecht = "w" Then
y = Rechnungsalter_Rente(EA, "w")

If y + AF + n < 121 Then
Einmalbetrag_netto = (Ny(y + AF).Value - Ny(y + n + AF).Value) / Dy(y).Value * jR

Else

Einmalbetrag_netto = (Ny(y + AF).Value) / Dy(y).Value * jR

End If

End If
Eintrittsalter = EA
End Function

Public Function Jahresbeitrag_netto(Eintrittsalter As Integer, Geschlecht As String, Aufschubfrist As Integer, jährliche_Rente As Integer, Versicherungsdauer As Integer) As Integer

Dim Dx, Dy, Nx, Ny As Range
Set Dx = Range("Dx")
Set Dy = Range("Dy")
Set Nx = Range("Nx")
Set Ny = Range("Ny")


AF = Aufschubfrist
jR = jährliche_Rente
n = Versicherungsdauer

If Geschlecht = "m" Then
x = Rechnungsalter_Rente(Eintrittsalter, "m")

Jahresbeitrag_netto = Einmalbetrag_netto(x, "m", AF, jR, n) / Leibrentenbarwert(x, "m", AF)

ElseIf Geschlecht = "w" Then
y = Rechnungsalter_Rente(EA, "w")

Jahresbeitrag_netto = Einmalbetrag_netto(y, "w", AF, jR, n) / Leibrentenbarwert(y, "w", AF)

End If

End Function

Function Monatsbeitrag_netto(Eintrittsalter As Integer, Geschlecht As String, Aufschubfrist As Integer, jährliche_Rente As Integer, Versicherungsdauer As Integer) As Long


AF = Aufschubfrist
jR = jährliche_Rente
n = Versicherungsdauer

If Geschlecht = "m" Then

x = Rechnungsalter_Rente(Eintrittsalter, "m")

Monatsbeitrag_netto = Einmalbetrag_netto(x, "m", AF, jR, n) / Leibrentenbarwert(x, "m", AF) / 12

ElseIf Geschlecht = "w" Then

y = Rechnungsalter_Rente(EA, "w")

Monatsbeitrag_netto = Jahresbeitrag_netto(y, "w", AF, jR, n) / 12

End If




End Function
Public Function Leibrentenbarwert(Eintrittsalter As Integer, Geschlecht As String, Aufschubfrist As Integer)

Dim Dx, Dy, Nx, Ny As Range
Set Dx = Range("Dx")
Set Dy = Range("Dy")
Set Nx = Range("Nx")
Set Ny = Range("Ny")

AF = Aufschubfrist


If Geschlecht = "m" Then
x = Rechnungsalter_Rente(Eintrittsalter, "m")

Leibrentenbarwert = (Nx(x).Value - Nx(x + AF).Value) / Dx(x).Value

ElseIf Geschlecht = "w" Then
y = Rechnungsalter_Rente(EA, "w")

Leibrentenbarwert = (Ny(y).Value - Ny(y + AF).Value) / Dy(y).Value

End If

End Function


Public Function Rechnungsalter_Rente(Eintrittsalter As Integer, Geschlecht As String) As Integer

Geburtsjahr = Year(Now) - Eintrittsalter



If Geschlecht = "m" Then

For Zeile = 9 To 34

Select Case Geburtsjahr

Case (Worksheets("Altersverschiebung").Cells(Zeile, 1).Value) To (Worksheets("Altersverschiebung").Cells(Zeile, 2).Value)

Altersverschiebung = Worksheets("Altersverschiebung").Cells(Zeile, 3).Value

End Select

Next Zeile

Rechnungsalter_Rente = Eintrittsalter + Altersverschiebung

ElseIf Geschlecht = "w" Then

For Zeile = 9 To 34 'Baust du schleifa

Select Case Geburtsjahr

Case (Worksheets("Altersverschiebung").Cells(Zeile, 5).Value) To (Worksheets("Altersverschiebung").Cells(Zeile, 6).Value)

Altersverschiebung = Worksheets("Altersverschiebung").Cells(Zeile, 7).Value

End Select

Next Zeile

Rechnungsalter_Rente = Eintrittsalter + Altersverschiebung




End If



End Function

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot VBA-Problem Schleife
07.11.2007 14:38:49 Tom
NotSolved
08.11.2007 09:51:25 Jerry
NotSolved