Preisberechnung mit mehrfachen Kombinationen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Werner,
so langsam verstehe ich deine Frage.
In der Tabelle "Berechnung" in "K2" bzw. generell in K:K stehen immer Modellcodes (jedes Kind hat einen Namen). Den Preis für den Modellcode berechne ich in der Spalte "BR" mit den Informationen aus der Tabelle "Modellpreise".
Meine Aufgabe ist es alle Preise in "BS" zu berechnen die in abhängigkeiten zu anderen PR-Codes oder in Abhängikeit zu Modellcodes stehen können.
Für unser Beispiel in "BS2" müsste man den Filter in "PR-Preise" wie folgt setzen:
1. MODELYEAR = 2015 (steht im Datensatz in der Tabelle "Berechnung" in "O2".
2. MODELGROUP = KF1 (steht im Datensatz in der Tabelle "Berechnung" in "AC2".
3. PRCODE = P20 (erster dreistelliger PR-Code im Datensatz in der Tabelle "Berechnung" in "N2".
Hier wird jetzt nur noch ein Ergebnis gefunden, der Preis ist in diesem Moment also eindeutig.
Es gibt aber viele Fälle bei denen das Ergebnis hier noch nicht so eindeutig ist.
Nehme mal den Datensatz aus Zeile 23 in der Tabelle "Berechnung", am beispiel vom sechsten PR-Code "PH1" und filter wieder entsprechend in der Tabelle "PR-Preise":
1. MODELYEAR = 2015 (steht im Datensatz in der Tabelle "Berechnung" in "O2".
2. MODELGROUP = KF1 (steht im Datensatz in der Tabelle "Berechnung" in "AC2".
3. PRCODE = PH1 (sechster dreistelliger PR-Code im Datensatz in der Tabelle "Berechnung" in "N2".
Es bleiben fünf Ergebnisse die weitere Prüfungen verlangen.
Enthält "N2" (Tabelle "Berechnung" einen der vier übrigen Codes (P20,P24,P21 oder P23) in H:H (Tabelle PR-Preise), wenn JA nimm den jeweiligen Preis (in diesem Beispiel immer 0), wenn NEIN, dann nimm den Preis ohne PACKAGECOMBI1, also 470,59 .
Weiter könnte es unterschiedliche Preise geben, sofern in der Tabelle "PR-Preise in F:F noch Modellcodes oder in I:I weitere PR-Codes eingetragen wären.
Mit der Filter-Methode kann es für jedes Fahrzeug immer nur einen Preis geben.
Ich hoffe jetzt ist es eindeutiger.
Gruß
Frank

Hi zusammen,
die Lösung (wenn sie denn bei mehr als dem 1. Datensatz richtig läuft) ist etwas tricky.
Ich habe in PR_Preise zwei Spalten angefügt:
O heißt "SortKombi" und enthält in O2 die Formel

=B2&E2&G2

Nach dieser Spalte wird sortiert; die jetzige Sortierreihenfolge ist etwas "seltsam", derweil etwa vorhandene PackageCombi zuerst aufsteigen sortiert sind, dann aber erst die eine nicht vorhandene kommt (zum besseren Verständnis in "Tabelle1" kopiert und markiert).
P heißt "Anzahl" und enthält in P2 die Formel

=WENN(O2O3;1;P3+1)

Diese Formel sorgt dafür, daß alle Zeilen mit gleichem "SortKombi" von *unten nach oben* durchnummeriert werden.
Sieh Dir z.B. (PR_Preise) die Zeilen 1939 bis 1943 an; hier sind zwei Dinge zu sehen: in Spalte P die besagten Nummern und in den Spalten F-H die gelbe Markierung, die ich testhalber gesetzt habe (also wenn die Const debuggen = true ist), um die Funktionsweise zu überprüfen.
Grundsätzlich ist es (für uns Menschen) nett, den Filter zu verwenden, um Sachen "auszusortieren", aber wie das Wort schon sagt, *programmiere* ich das lieber "sortiert" - nicht "gefiltert".
Das Makro setzt aus den Angaben in "Berechnung" die SortKombi zusammen, springt sie mit einem simplen Suchbefehl an und ...
- liest den *einen* vorhandenen Wert, wenn in Spalte I eine 1 steht oder ...
- kopiert den gelb markierten Bereich in ein Array, eine VBA-interne Speicherstruktur und sucht dort nach Kombi bzw. Modell.
Das Makro:

Option Explicit
Sub Preis_Ermitteln()
Dim i&, k&, z&, anzahl&, B_max&
Dim P_von&, P_bis&, P_max&
Dim c As Range
Dim erster$
Dim finden$
Dim a As Variant, aa As Variant, b As Variant, wert As Variant
Dim preis As Double
Dim gefunden As Boolean, fehler As Boolean
Const debuggen = True  ' ********** auf false setzen, wenn es richtig laufen soll
MsgBox "Debuggen (Testen) = " & debuggen
P_max = PrPreise.Range("A" & Rows.Count).End(xlUp).Row
B_max = Berechnung.Range("BU" & Rows.Count).End(xlUp).Row
If debuggen Then B_max = 2 ' solange debuggen true ist, wird B_max auf 2 gesetzt
For z = 2 To B_max
fehler = False
a = Berechnung.Range("K" & z & ":AC" & z)
' 1: Modellcode
' 4: PrNummern
' 5: Modeljahr
'19: ModellGruppe
a(1, 4) = Replace(a(1, 4), "/", "")
aa = Split(a(1, 4), " ")
'  MsgBox LBound(aa) & " " & UBound(aa)
preis = 0#
For i = LBound(aa) To UBound(aa)
If Trim(aa(i))  "" Then
finden = a(1, 5) & a(1, 19) & aa(i)
If debuggen Then Debug.Print "Zeile Nr. " & z & " Suchen nach: " & finden
With PrPreise
Set c = .Range("O2:O" & P_max).Find(finden, LookIn:=xlValues)
If Not c Is Nothing Then
P_von = c.Row
P_bis = .Range("P" & P_von)
If P_bis = 1 Then
preis = preis + .Range("N" & P_von).Value
Else
b = .Range("F" & P_von & ":H" & P_von + P_bis - 1)
'       MsgBox .Range("F" & P_von & ":H" & P_von + P_bis - 1).Address
If debuggen Then
.Range("F" & P_von & ":H" & P_von + P_bis - 1).Interior.Color = vbYellow
End If
gefunden = False
k = 1
Do
'        Stop
If (b(k, 3)  "") And (InStr(1, a(1, 4), b(k, 3)) > 0) Then
preis = preis + .Range("N" & P_von + k - 1)
gefunden = True
End If
If (b(k, 1)  "") And (InStr(1, a(1, 1), b(k, 1)) > 0) Then
preis = preis + .Range("N" & P_von + k - 1)
gefunden = True
End If
k = k + 1
Loop Until gefunden Or k > P_bis
If Not gefunden Then preis = preis + .Range("N" & P_von)
End If
Else
fehler = True
End If
If debuggen Then Debug.Print preis
End With
End If
Next
If fehler Then
Berechnung.Range("BS" & z).Value = "n.v."
Else
Berechnung.Range("BS" & z).Value = preis
End If
Next
End Sub

Die Datei: https://www.herber.de/bbs/user/101624.zip
Happy Exceling,
Michael
P.S.: Das hat so rund 3 Stunden gedauert - mehr nur gegen Kohle.

Beliebteste Forumthreads (12 Monate)

Preisberechnung mit mehrfachen Kombinationen

14 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread