Samle info i een række

Jeg tror du bliver nødt til at skrive noget VBA-kode der looper igennem din tabel, og eventuelt legger resultatet i et nyt sheet.

En måde at gøre det på, er at sortere din nuværende tabel efter kolonne B, og få VBA-koden til at løbe igennem listen, og skrive resultatet til dit nye sheet.

Jeg har lavet lidt kode som kan gøre dette:
Sub TransformData()
   
'Forudsætninger:
'Kildedata findes i en range med navne 'Source', kolonne B har varnummer og kolonne D værdien
'Ark med kildedata heder 'Sheet1'
'Ark som der skal skrives til heder 'Sheet2'

    Dim colB As Integer                'Tildeles værdien af kolonne B
    Dim rowDest As Integer              'Holder styr på hvilke række der skrives til
    Dim sheetDest As Excel.Worksheet    '

    Dim rng As Excel.Range
    Set rng = Range("Source")
   
'    Range("A2:D10").Select
'    ActiveWorkbook.Names.Add Name:="Source", RefersToR1C1:="=Sheet1!R2C1:R10C4"

    Excel.Worksheets("Sheet1").Select
    rng.Select
    Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
           
    colB = rng(1, 2)
    rowDest = 1
   
    'Går over til arket "Dest"
    Set sheetDest = Excel.Worksheets("Sheet2")
    sheetDest.Activate
   
    'Overskrifter
    Range("A1").Select
    Selection.Font.Bold = True
    ActiveCell.FormulaR1C1 = "Varenummer"
    Range("B1").Select
    Selection.Font.Bold = True
    ActiveCell.FormulaR1C1 = "Antal forek."
   
    'Starter i A2
    Range("A2").Select
    ActiveCell.FormulaR1C1 = colB
    ActiveCell.Offset(0, 1).Select
    ActiveCell.FormulaR1C1 = rng(1, 4)
   
    For x = 2 To rng.Rows.Count
        If rng(x, 2) <> colB Then
            colB = rng(x, 2)
            If colB = 0 Or IsNull(colB) Then Exit For
            rowDest = rowDest + 1
            Range("A" & CStr(rowDest + 1)).Select
            ActiveCell.FormulaR1C1 = colB
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = rng(x, 4)
        Else
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = rng(x, 4)
        End If
    Next x
   
End Sub

meget avanceret - tak for hjælpen.  Kom med et svar

kom med et svar hvis du vil have point :-)

svar (beklager lang svartid) :-)

Det var kun en komentar - kom med et rigtigt svar og få point :-)

vi prøver igen :-)