Strukturaufrechnung per VBA?!?
17.08.2006 08:30:38
Mike28
ich hoffe, es kann mir hier jemand weiterhelfen. Es geht um folgendes:
Ich möchte eine Strukturstückliste aufrechnen und finde nicht die richtige Formel. Beispiel: In Spalte A ist die Strukturstufe in Spalte B ist der Preis in Spalte C ist die Aufrechnung des Preises anhand der Struktur (was ich mit einer Formel oder per VBA machen möchte) mit folgenden Kriterien: Die Aufrechnung des Preises in Spalte C für die Strukturstufe 2 beinhaltet alle Preise der Struckturstufe 3 bis zur nächsten Strukturstufe 2. Die Aufrechnung des Preises in Spalte C für die Strukturstufe 3 beinhaltet alle Preise der Strukturstufe 4 bis zu nächsten Strukturstufe 3. So gehts weiter mit allen weiteren Stufen. Ich habe die Ergebnisse in Spalte C manuell ausgerechnet. Wie kann ich das mit einer Formel, resp. per VBA in Spalte C machen die ich "runterkopieren möchte".
A B C
2 0 35
3 10 10
3 0 5
4 5 5
3 0 20
4 0 15
5 15 15
4 0 5
5 5 5
Habe hier bereits folgende Ansätze gefunden (jedoch bereits 5 Jahre alt. Habe beides ausprobiert. Entweder bin ich dafür zu blöd oder es geht aus Gründen der neueren Version nicht mehr). Hoffe, dies kann hier ein Spezialist nutzen, um es für Excel 2003 umzusetzen.
Falls es was bringen kann, könnte ich auch die entsprechnde Beispieldatei zusenden.
Vielen Dank für jegliche Hilfe.
Gruss
Mike
_________________________________________________________________________
Beispiel UDF:
Option Explicit
Function GetWert(rng As Range) As Double
Dim lngAkt As Long
lngAkt = 1
With rng
GetWert = .Offset(0, 1)
While .Value < .Offset(lngAkt, 0) And .Offset(lngAkt, 0) <> ""
GetWert = GetWert + .Offset(lngAkt, 1)
lngAkt = lngAkt + 1
Wend
End With
End
Function
_________________________________________________________________________
Beispiel VBA:
Option Explicit
Sub Setzen()
Dim lngAkt As Long, lngLast As Long
Dim intAkt As Integer
Dim arr As Variant
arr = Array(1, 4, 7) 'Spaltennummern ...
For intAkt = 0 To UBound(arr)
lngLast = Cells(Rows.Count, arr(intAkt)).End(xlUp).Row
lngAkt = 1
For lngAkt = 1 To lngLast
Cells(lngAkt, arr(intAkt) + 2) = GetWert(Cells(lngAkt, arr(intAkt)))
Next lngAkt
Next intAkt
End
Sub
Function GetWert(rng As Range) As Double
Dim lngAkt As Long
lngAkt = 1
With rng
GetWert = .Offset(0, 1)
While .Value < .Offset(lngAkt, 0) And .Offset(lngAkt, 0) <> ""
GetWert = GetWert + .Offset(lngAkt, 1)
lngAkt = lngAkt + 1
Wend
End With
End Function
_________________________________________________________________________
Beispiel Formel:
Ich habe in die Formel noch hinter Vergleich eine -1 angefügt damit der nächste gefundene Vergleichswert nicht mit summiert wird. Das geht auch. Ein Fehler ist noch drin: siehe angefügte Tabelle. In Spalte C ist wie es die Formel macht ind Spalte D ist wie es sein soll. Un man sieht, daß der 4 Wert von Spalte C (20) falsch ist, weil die Formel bis zur nächsten Stufe 4 sumiert sucht und nicht erkennt, daß nur bis zur nächsten Stufe 2 sumiert werden darf, weil wenn eine kleiner Stufe als Zahl folgt also die 2 beginnt in der Stückliste ein neues Bauteil. Irgendwie muß noch in die Formel rein, daß nur alle größeren Stufen bis zur nächst kleineren summiert werden dürfen. Aber wie?
=SUMME(INDIREKT("B"&ZEILE(A2:$A10002)&":B"&WENN(ISTFEHLER(VERGLEICH(A2;A3:A$10002;0)-1);10000;VERGLEICH(A2;A3:A$10002;0)-1+ZEILE())))
A B C D
2 0 20 20
3 0 20 20
4 10 10 10
4 10 20 10
2 0 30 30
3 10 10 10
3 0 20 20
4 10 10 10
4 10 10 10
_________________________________________________________________________