optellen BOM level structuur

[noci]

Hoi.

kan iemand mij een macro bezorgen voor het optellen in een Bill Of Material level structuur.

alvast bedankt.

 

[keesbl]

Welkom op het forum,

Het is een goede gewoonte om een voorbeeldbestand mee te posten, dan krijg je zeker antwoord.
Nu is het koffiedik kijken wat je bedoelt.

Kees

 

[noci]

hierbij een voorbeeld file

 

[sylvester-ponte]

gebruik in kolom I overal SUBTOTAAL ipv SOM

 

[MarcelBeug]

Een oplossing met een draak van een matrixformule in F2 (bevestigd met Ctrl+Shift+Enter), gekopieerd naar rechts en naar beneden t/m I52:

=ALS($A2=KOLOMMEN($F:F)-1;ALS($D2<>"";$D2*$C2;G2*$C2);ALS($A2=KOLOMMEN($F:F)-2;SOM(F3:INDEX(F:F;ALS.FOUT(1/(1/MIN(ALS(E3:E$1000<>"";RIJ(E3:E$1000)-1)));1000)));""))

 

[noci]

Bedankt Marcel,

ik ga het deze week eens proberen.

( kan dit ook in een macro gezet worden.)

Nico

 

[sylvester-ponte]

met function zie grijze cel:

 

[Timshel]

Ik kom uit op deze:

Sub tsh()
    Dim Br, Bs
    Dim arrSubT
    Dim i As Long
    Dim Level As Long
    
    ReDim arrSubT(1 To 5)
    Br = Sheets("Blad1").Cells(1).CurrentRegion
    ReDim Bs(2 To UBound(Br), 1 To 4)
    For i = UBound(Br) To 2 Step -1
        Level = Br(i, 1) + 1
        Bs(i, Level) = IIf(Level = 4, Br(i, 4), arrSubT(Level + 1)) * Br(i, 3)
        arrSubT(Level) = arrSubT(Level) + Bs(i, Level)
        If Level < 4 Then
            Bs(i, Level + 1) = arrSubT(Level + 1)
            arrSubT(Level + 1) = 0
        End If
    Next
    Sheets("Blad1").Cells(2, 6).Resize(UBound(Bs) - 1, 4) = Bs
End Sub

 

[snb]

Sub M_snb()
  For Each ar In Cells(1).CurrentRegion.Columns(4).Offset(1).SpecialCells(2).Areas
    If ar.Cells(1).Offset(-1) = "" Then x = Application.SumProduct(ar.Value, ar.Offset(, -1).Value) * ar.Cells(1).Offset(-1, -1)
    If ar.Cells(1).Offset(-2) = "" Then x = x * ar.Cells(1).Offset(-2, -1)
    y = y + x
  Next
  
  Cells(60, 4) = y
End Sub

 

[sylvester-ponte]

deze berekent van iedere "Bom_tabel" de uitkomst:

Function Telling(Tabel As Range)
    Set Opl = CreateObject("Scripting.Dictionary")
    For Rij = Tabel.Rows.Count To 1 Step -1
        If Tabel(Rij, 2) <> "" Then
            Diepte = 0
            Opl(Diepte) = Opl(Diepte) + Tabel(Rij, 1) * Tabel(Rij, 2)
        Else
            Diepte = Diepte + 1
            Opl(Diepte) = Opl(Diepte) + Opl(Diepte - 1) * Tabel(Rij, 1)
            Opl(Diepte - 1) = 0
        End If
    Next
    Telling = Opl(Opl.Count - 1)
End Function

 

[snb]

@Syl

Berekend is een voltooid deelwoord; berekent is derde persoon enkelvoud tegenwoordige tijd (die eindigt altijd !! op een t; dat kun je dus niet fout doen).

 

[sylvester-ponte]

snb, bedankd

 

[snb]

@sylv

Ik kan je als niet-verenigingslid (waarom worden wij geen lid honoris causa ?) geen PM sturen.

 

[sylvester-ponte]

ik ga zo de betaling op de bus doen (automatische incasso )

dank zij jou een nieuw lid er bij