Cel waardes optellen op basis van celwaarde

[Jasper91]

Goedemorgen,

Ik heb een excel document welke heel gedetailleerd een productconfiguratie opbouwt.
Vanuit dit document wordt een lijst naar access 'geschoten' met alle onderdelen die besteld moeten worden.

Nu is het mogelijk dat 1 moertje op meerdere regels voorkomt, in verschillende hoeveelheden.
Ik wil echter, voordat de lijst naar access gaat, dat van elke artikel 1 regel gemaakt wordt. M.a.w. als ik 3 regels heb met hetzelfde moertje wil ik dat deze gegroepeerd worden tot 1 regel, maar dat wel alle hoeveelheden bij elkaar worden opgeteld.

Ik heb zelf al het e.e.a. getest, maar de macro werkt nog niet vlekkeloos.

Sub MergeItemNumbers()
Dim MyRow As Long
Dim MyRow2 As Long

Sheets("Export").Select

MyRow = 3
Cells(MyRow, 1).Select
Do Until MyRow = 500
    MyRow2 = 4
        Cells(MyRow2, 1).Select
        Do Until MyRow2 = 500
            If Cells(MyRow2, 1).Value = Cells(MyRow, 1).Value Then
                Cells(MyRow, 2).Value = Cells(MyRow, 2).Value + Cells(MyRow2, 2).Value
                Cells(MyRow, 5).Value = Cells(MyRow, 5).Value + Cells(MyRow2, 5).Value
                Cells(MyRow2, 1).ClearContents
            End If
        MyRow2 = MyRow2 + 1
        Loop
    MyRow = MyRow + 1
    Loop

End Sub

Qua code is het nog niet ideaal, het moet nog beknopter worden, maar ik heb het zo gedaan om eerst de werking goed te krijgen.
Deze macro voegt voor het eerste artikel alles goed samen, maar gaat vervolgens niet terug in de 1e loop.

Ter verduidelijking heb ik ook een excel document bijgevoegd.

Bekijk bijlage Helpmij voorbeeld.xlsx

 

[Niels28]

Sub test()
    With Sheets("sheet1")
        For Each cl In .Range("b5:b" & .Cells(Rows.Count, 2).End(xlUp).Row)
            If InStr(c01, cl.Value) = 0 Then
                c01 = c01 & "||" & cl.Value
                cl.Offset(, 1).Value = WorksheetFunction.SumIf(.Range("B:B"), cl.Value, .Range("c:c"))
                cl.Offset(, 4).Value = WorksheetFunction.SumIf(.Range("B:B"), cl.Value, .Range("F:F"))
            Else
                cl.Resize(, 5).ClearContents
            End If
        Next
    End With
End Sub

Niels

 

[Jasper91]

Hartstikke bedankt Niels!

Het werkt prima, fijn dat je me zo snel hebt kunnen helpen!