Hilfe bei VBA



Excel-Version: 2002
nach unten

Betrifft: Hilfe bei VBA
von: Ralf Becker
Geschrieben am: 04.05.2002 - 21:08:46

Hallo - ich bastel seit drei Tagen an einem Programm und bin schon weit gekommen - jetzt steh ich vor einem neuen Problem:
Wie kann ich folgendes umsetzen:
Man gibt z.b. in B5 eine Summe ein und in B9 auch. In Abhängigkeit von der Höhe der ersten Summe, erfolgt zu der zweiten Summe eine Berechnung.
Beispiel:
Eingabe in B5 = 250.000 (Deckungssumme)
Eingabe in B9 = 100.000 (Honorar)
So Excel muss nun wissen, das es bei einer Deckungssumme von 250.000 und einem Honorar von 100.000 den Wert 100.000 mit 6,1% multiplizieren muss - das Ergebnis wird in C9 ausgeworfen. Bis hier hin klappt alles Prima und ich weiss auch wie - aber jetzt!
Wenn aber in B5 500.000 Deckungsumme eingegeben wird, muss excel wissen - aha hier muss ich nicht 6,1, sondern 15 % Zuschlag nehmen, und bei 1.000.000 25 % Zuschlag usw. - Das krige ich nicht hin - kann mir jemand helfen? Also drei Stufen:
1. Deckungsumme - 2. Höhe des Honorars 3. Beitrag
Hier der bisherige Code:

Option Explicit
Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim tb As Worksheet
Dim A As Single
Dim B As Single

Set tb = Worksheets("Architekt")

tb.Unprotect Password:="assia"
tb.Protect Password:="assia", UserInterfaceOnly:=True

On Error GoTo Fehler
Application.EnableEvents = False
If Target.Address = "$B$9" Then
If IsNumeric(tb.[B9].Value) Then 'Abfrage, ob Zahl
A = tb.[B9].Value
Select Case A
Case Is <= 25000
B = A * 0.0564
Case Is <= 35000
B = A * 0.0481
Case Is <= 50000
B = A * 0.0393
Case Is <= 75000
B = A * 0.0348
Case Is <= 100000
B = A * 0.032
Case Is <= 150000
B = A * 0.0313
Case Is <= 200000
B = A * 0.028
Case Is <= 250000
B = A * 0.0266
Case Is <= 500000
B = A * 0.024
Case Is <= 750000
B = A * 0.0216
Case Is <= 1000000
B = A * 0.0194

End Select
tb.[C9].Value = Format(Round(B, 2), "#,###.#0 €") 'Ausgabe in Zelle C9
End If
End If


Application.EnableEvents = True
Exit Sub
Fehler:
End Sub

EUCH schon mal Danke!!!

nach oben   nach unten

Re: Hilfe bei VBA
von: Nicht 6,1!
Geschrieben am: 04.05.2002 - 21:15:38

bei 100.000 wird nicht 6,1, sondern lt. Tabelle 3,32 multipliziert.

Wie kriege ich das nur hin, dass Excel zwei Dinge prüft:

wenn Deckungssumme 250.000 und Honorar z.B. 100.000, dann nehme 3,32, wenn aber Deckungssumme 500.000 und Honorar 75.000 ist, dann nehme Beitragssatz 3,348 + 15 %!

Wisst Ihr was ich meine?

nach oben   nach unten

Re: Hilfe bei VBA
von: Hans W. Herber
Geschrieben am: 05.05.2002 - 06:05:49

Hallo Ralf,

der erste Gedanke: Warum VBA, warum nicht einfach nur eine Excel-Tabelle mit den Bedingungen und eine Excel-Formel?

Sollte es denn VBA sein, warum nicht die Bedingungen in einer Tabelle hinterlegen?

Sollten die Bedingungen nicht hinterlegt werden, warum nicht der Einsatz von Excel-Formeln zur Ermittlung der Werte?

Wenn Du bei Deinem Konstrukt bleiben möchtest, musst Du für die zweite Bedingung innerhalb der einzelnen Select-Case-Abfrage neue Select-Case-Abfragen bilden. Bei mehreren Bedingungen wird das leicht unübersichtlich.

Deshalb folgender Lösungsvorschlag:


Sub Worksheet_Change(ByVal Target As Excel.Range)
   Dim arrA(1 To 11, 1 To 2) As Double, arrB(1 To 3, 1 To 2) As Double
   Dim dblA As Double, dblB As Double
   On Error GoTo ERRORHANDLER
   If Intersect(Target, Range("B5,B9")) Is Nothing Then Exit Sub
   If Not IsNumeric(Target.Value) Then Exit Sub
   Application.EnableEvents = False
   arrA(1, 1) = 0
   arrA(1, 2) = 0.0564
   arrA(2, 1) = 25000
   arrA(2, 2) = 0.0481
   arrA(3, 1) = 35000
   arrA(3, 2) = 0.0393
   arrA(4, 1) = 50000
   arrA(4, 2) = 0.0348
   arrA(5, 1) = 75000
   arrA(5, 2) = 0.032
   arrA(6, 1) = 100000
   arrA(6, 2) = 0.0313
   arrA(7, 1) = 150000
   arrA(7, 2) = 0.028
   arrA(8, 1) = 200000
   arrA(8, 2) = 0.0266
   arrA(9, 1) = 250000
   arrA(9, 2) = 0.024
   arrA(10, 1) = 500000
   arrA(10, 2) = 0.0216
   arrA(11, 1) = 750000
   arrA(11, 2) = 0.0194
   
   arrB(1, 1) = 0
   arrB(1, 2) = 15 / 100
   arrB(2, 1) = 500000
   arrB(2, 2) = 25 / 100
   arrB(3, 1) = 750000
   arrB(3, 2) = 35 / 100
   
   dblA = Range("B9").Value
   dblB = Range("B5").Value
   
   dblA = WorksheetFunction.VLookup(dblA, arrA, 2, 1)
   dblB = WorksheetFunction.VLookup(dblB, arrB, 2, 1)
   
   Range("C9").Value = (Range("B9").Value * dblA) + _
      ((Range("B9").Value * dblA) * dblB)
ERRORHANDLER:
Application.EnableEvents = True
End Sub

Noch was: Wenn Du einen ERRORHANDLER zum Abfangen von Fehlern einbaust, sollte das Einschalten der Ereignisse sinnvollerweise nach der Sprungmarke liegen.

So ganz sicher bin ich nicht, ob ich den von Dir gewollten Rechenvorgang verstanden habe, aber Du kannst den Code ja anpassen.

hans

 nach oben

Beiträge aus den Excel-Beispielen zum Thema "kann excel nicht öffnen (Fehlermeldung)"