Thema Datum  Von Nutzer Rating
Antwort
Rot Berechnung
27.03.2012 17:00:55 karyou
NotSolved
27.03.2012 19:04:12 Till
*****
Solved
28.03.2012 09:01:02 karyou
NotSolved

Ansicht des Beitrags:
Von:
karyou
Datum:
27.03.2012 17:00:55
Views:
1712
Rating: Antwort:
  Ja
Thema:
Berechnung

Guten Tag

Ich wäre sehr dankbar, wenn mir jemand diesen Code erkären könnte, da ich leider kein vb verstehe.
Der Code funktioniert auch leider nicht mehr, da es aus einer sehr alten AccessDB ist. Ich möchte diese Berechnung nun ohne VB in einer Excel Tabelle speichern. Das Resultat der Berechnung sollte folgendes ergeben:
Nach eingabe der Läng und Breite und der Qualität (W...) berechnet die Formel den Preis des Gehäuses:

Function Preise_Chassis_W0 ()
'
' Mit dieser Funktion wird der Preis eines Gehäuses/Chassis Typ W errechnet.
'
'
Dim Typ As String
Dim Länge As Integer
Dim Breite As Integer
Dim grösse2 As Integer
Dim Preis2 As Single
Static Grösse(60) As Integer
Static Preis(60) As Single
Dim Grösse_Array As Integer  ' Grösse Array
Dim i As Integer
Dim x As Integer
Dim y As Single

Grösse_Array = 48

Grösse(1) = 65
Grösse(2) = 70
Grösse(3) = 75
Grösse(4) = 80
Grösse(5) = 85
Grösse(6) = 90
Grösse(7) = 95
Grösse(8) = 100
Grösse(9) = 105
Grösse(10) = 110
Grösse(11) = 115
Grösse(12) = 120
Grösse(13) = 125
Grösse(14) = 130
Grösse(15) = 135
Grösse(16) = 140
Grösse(17) = 145
Grösse(18) = 150
Grösse(19) = 155
Grösse(20) = 160
Grösse(21) = 165
Grösse(22) = 170
Grösse(23) = 175
Grösse(24) = 180
Grösse(25) = 185
Grösse(26) = 190
Grösse(27) = 195
Grösse(28) = 200
Grösse(29) = 205
Grösse(30) = 210
Grösse(31) = 215
Grösse(32) = 220
Grösse(33) = 225
Grösse(34) = 230
Grösse(35) = 235
Grösse(36) = 240
Grösse(37) = 245
Grösse(38) = 250
Grösse(39) = 255
Grösse(40) = 260
Grösse(41) = 265
Grösse(42) = 270
Grösse(43) = 275
Grösse(44) = 280
Grösse(45) = 285
Grösse(46) = 290
Grösse(47) = 295
Grösse(48) = 300


Preis(1) = 17.5
Preis(2) = 18.5
Preis(3) = 19.5
Preis(4) = 20.5
Preis(5) = 21.5
Preis(6) = 22.5
Preis(7) = 23.5
Preis(8) = 25
Preis(9) = 27.5
Preis(10) = 30
Preis(11) = 34
Preis(12) = 38
Preis(13) = 42
Preis(14) = 46
Preis(15) = 48
Preis(16) = 50
Preis(17) = 52
Preis(18) = 55
Preis(19) = 57.5
Preis(20) = 60
Preis(21) = 65
Preis(22) = 70
Preis(23) = 73
Preis(24) = 76
Preis(25) = 78
Preis(26) = 80
Preis(27) = 83
Preis(28) = 86
Preis(29) = 89
Preis(30) = 92
Preis(31) = 95
Preis(32) = 98
Preis(33) = 101
Preis(34) = 104
Preis(35) = 107
Preis(36) = 110
Preis(37) = 114
Preis(38) = 118
Preis(39) = 122
Preis(40) = 128
Preis(41) = 131
Preis(42) = 132
Preis(43) = 140
Preis(44) = 145
Preis(45) = 150
Preis(46) = 155
Preis(47) = 160
Preis(48) = 165

If IsNull(Forms![Chassis W0]![Breite]) Or Forms![Chassis W0]![Breite] <> Int(Forms![Chassis W0]![Breite]) Then
    Beep
    x = MsgBox("Bitte nur ganze Zahlen eingeben", 48, "Eingabeprüfung")
    DoCmd CancelEvent
    DoCmd GoToControl "[Breite]"
    Exit Function
Else
End If

Typ = Forms![Chassis W0]![Typ]
Länge = Forms![Chassis W0]![Länge]
Breite = Forms![Chassis W0]![Breite]
grösse2 = Länge + Breite


If grösse2 > Grösse(Grösse_Array) Then          ' ab 300 cm kosten jede weitere 5cm 8.--
    y = grösse2 - Grösse(Grösse_Array)
    y = y / 5
    If y <> Int(y) Then y = y + 1
    y = Int(y)
    Preis2 = Preis(Grösse_Array) + (y * 8)
Else
    i = Grösse_Array
    Do Until grösse2 > Grösse(i)
        i = i - 1
    Loop
    Preis2 = Preis(i + 1)
End If
If Typ = "W0" Then
ElseIf Typ = "W1" Then
    Preis2 = Preis2 * 1.1
ElseIf Typ = "W2" Then
    Preis2 = Preis2 * 1.2
ElseIf Typ = "W3" Then
    Preis2 = Preis2 * 1.3
ElseIf Typ = "W4" Then
    Preis2 = Preis2 * 1.4
ElseIf Typ = "W5" Then
    Preis2 = Preis2 * 1.5
ElseIf Typ = "W6" Then
    Preis2 = Preis2 * 1.6
ElseIf Typ = "W7" Then
    Preis2 = Preis2 * 1.7
ElseIf Typ = "W8" Then
    Preis2 = Preis2 * 1.8
ElseIf Typ = "W9" Then
    Preis2 = Preis2 * 1.9
ElseIf Typ = "W10" Then
    Preis2 = Preis2 * 2
ElseIf Typ = "W11" Then
    Preis2 = Preis2 * 2.1
ElseIf Typ = "W12" Then
    Preis2 = Preis2 * 2.2
ElseIf Typ = "W13" Then
    Preis2 = Preis2 * 2.3
ElseIf Typ = "W14" Then
    Preis2 = Preis2 * 2.4
ElseIf Typ = "W15" Then
    Preis2 = Preis2 * 2.5
ElseIf Typ = "W16" Then
    Preis2 = Preis2 * 2.6
ElseIf Typ = "W17" Then
    Preis2 = Preis2 * 2.7
ElseIf Typ = "W18" Then
    Preis2 = Preis2 * 2.8
ElseIf Typ = "W19" Then
    Preis2 = Preis2 * 2.9
ElseIf Typ = "W20" Then
    Preis2 = Preis2 * 3
ElseIf Typ = "W21" Then
    Preis2 = Preis2 * 3.1
ElseIf Typ = "W22" Then
    Preis2 = Preis2 * 3.2
ElseIf Typ = "W23" Then
    Preis2 = Preis2 * 3.3

End If

If grösse2 > 190 Then
    Forms![Bestellung erfassen]![Bestellpositionen erfassen].Form![Zusatz_Chassis_W] = "Chassis verstrebt " & Typ & Str(Länge) & " x" & Str(Breite) & " cm"
Else
    Forms![Bestellung erfassen]![Bestellpositionen erfassen].Form![Zusatz_Chassis_W] = "Chassis " & Typ & Str(Länge) & " x" & Str(Breite) & " cm"
End If
Forms![Bestellung erfassen]![Bestellpositionen erfassen].Form![Bestellpositionen.Preis] = Preis2
DoCmd Close
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 Berechnung
27.03.2012 17:00:55 karyou
NotSolved
27.03.2012 19:04:12 Till
*****
Solved
28.03.2012 09:01:02 karyou
NotSolved