Sorteren van rijen met langste aantal kolommen

[Ruken]

Goeden middag medeprogrammeurs,

Allereerst bedankt voor het openen van mijn topic en eventuele hulp.

Ik zit een knelpunt en weet niet hoe ik eruit moet komen.

De situatie is als volgt:

Codenaam
D-C-B-A
A
C-B-A
B-A

D C B A
A
C B A
B A

Afzet
1
2
3
4

Omzet
5
6
7
8

Ik heb een aantal codenamen van artikelen, met bijbehorende afzet en omzet.
De codenamen heb ik gescheiden, dmv Tekst naar kolommen, omdat ik denk dat het makkelijker is om te programmeren.
Nu is het zo dat het artikel met codenaam A ondergebracht is onder B-A en B-A onder C-B-A en C-B-A onder D-C-B-A.
Dat betekent dat die afzet en omzet bij mekaar opgeteld moeten worden. Uiteindelijk moeten de juiste codes ergens uitgeprint worden met afzet en omzet.
Dit is slecht een voorbeeld want oorspronkelijk staan er honderden artikelen!
Nou is mijn vraag hoe ik dit het beste kan aanpakken. Moet ik eerst sorteren van rijen maar dan moet alles mee gesorteerd worden?
Of is het sorteren van kolommen? Kan iemand mij zijn/haar inzichten verschaffen met eventueel met een programma?
Want ik kom zelf niet uit..

Alvast bedankt!

Mvg, Ruken

 

[HSV]

Misschien moet je even een Excel voorbeeld-bestand plaatsen, met graag een uitkomst wat je voor ogen hebt.
Geen plaatje, maar een .xlsx extensie.

 

[Ruken]

Hallo allemaal,

Ik had hiervoor een stukje code geschreven, maar voert het gedeeltelijk uit.

 Sub Codenaam_scheiden()

Dim i As Integer, j As Integer

For i = 1 To 3
    For j = 1 To 3
        If Cells(i, 2).Value = Cells(i + 1, j + 2).Value Then
            If Not Cells(i + 1, j + 1).Value = "" Then
            Cells(i + 1, 10) = Cells(i + 1, 1).Value
            Cells(i + 1, 11) = Cells(i + 1, 8).Value + Cells(i, 8).Value
            Cells(i + 1, 12) = Cells(i + 1, 9).Value + Cells(i, 9).Value
            End If
        End If
    Next j
Next i

End Sub

Ik kreeg dit als resultaat:


Heeft iemand enig idee hoe het verder moet?

 

[Ruken]

Hallo HSV,

Bedankt voor je reactie.
Dit is eigenlijk wat ik voor ogen heb.Bekijk bijlage Voorbeeld.xlsx

Ik hoop dat het nu wat duidelijker is.

Alvast bedankt.

Mvg, Ruken

 

[HSV]

Ik weet niet wat ik er van moet maken als er nog andere codes bij komen.
Voor nu.

Sub hsv()
Dim sn, i As Long, sq, arr
sn = Cells(1).CurrentRegion.SpecialCells(2).Offset(1).SpecialCells(2).Resize(, 8)
ReDim arr(0 To UBound(sn), 0 To 2)
 For i = 1 To UBound(sn)
  sq = Split(sn(i, 1), "-")
    If InStr(sn(i, 1), sq(UBound(sq))) Then
        arr(0, 0) = sn(i, 1)
        arr(0, 1) = arr(0, 1) + sn(i, 7)
        arr(0, 2) = arr(0, 2) + sn(i, 8)
    End If
  Next i
Range("N2").Resize(, 3) = arr
End Sub

 

[Ruken]

Hallo Harry,

Dank voor de code en sorry voor de late reactie.
De code werkt goed, alleen hij geeft niet de juiste codenaam. Hij hoort de meest recente codenaam te geven, de oude codenamen staan dan achter het "-" minteken.
In dit geval moet alleen de codenaam D-C-B-A staan. De afzet en omzet kloppen wel.
Ik had een stukje code geschreven om de codenamen te eerst te splitsen:

For i = 2 To Range("A2").CurrentRegion.Count
'Codenaam wordt gesplitst door "-"
        Ruler = Split(Ruler(1), "-")
        Teller = UBound(Ruler)
        For j = 0 To Teller
            Cells(i, 2 + j) = Ruler(j)
        Next j
Next i

Maar beide codes gaan niet samen. Heb je enig idee hoe dit op te lossen?

 

[HSV]

Helaas begrijp ik het niet.
De code geeft toch netjes D-C-B-A weer in cel N2 ?

 

[Ruken]

Nee, de code geeft de codenaam die helemaal onderaan staat. Ik snap op moment ook niet

 

[HSV]

Test één, twee.

 

[Ruken]

Harry,

Hij doet het nu wel, alleen als je een bepaalde codenaam onderaan zet. Het is wel de bedoeling dat ie het automatisch sorteert. Ik heb daarvoor een macro opgenomen en in de VBA code gestopt. Ik laat je nu de echte codenamen zien.

Sub Sorteren_en_scheiden()

Dim i As Integer, j As Integer
'Dim rng As Range, rng2 As Range, rng3 As Range
Dim Ruler As Variant
Dim Teller As Long

Set rng = Range("A2").CurrentRegion
'Set rng2 = Range("D3").CurrentRegion
'Set rng3 = Range("E4").CurrentRegion

'Hier worden de codenamen voorzien van een getal, afhankelijk hoeveel streepjes in de codenaam
For i = 1 To rng.Count
    Ruler = Split(rng.Cells(i), "-")
    Teller = UBound(Ruler)
    Cells(i + 1, 2) = Teller
Next i

'Hier wordt de kolom van de codenamen eerst gescheiden, Kolom A
Range("A2:A83").Select
    Selection.TextToColumns Destination:=Range("C2"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=True, OtherChar:= _
        "-", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), _
        TrailingMinusNumbers:=True

'Hier worden de kolommen gesorteerd op de "-"teller(Kolom B),Codenaam, afzet en omzet
Range("A1:N1").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Blad1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Blad1").AutoFilter.Sort.SortFields.Add Key:=Range( _
        "B1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Blad1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Selection.AutoFilter

'Hier wordt de delen van de codenamen vergeleken en als
'de deelcodes hetzelfde zijn worden de afzet en de omzet van de codenamen bij mekaar opgeteld.
For i = 1 To 82
    For j = i + 1 To 83
        If Cells(j, 5).Value = Cells(i, 4).Value Then
            Cells(i, 12) = Cells(j, 1).Value
            Cells(j, 1).Interior.ColorIndex = 3
            Cells(i, 13) = Cells(j, 9).Value + Cells(i, 9).Value
            Cells(i, 14) = Cells(j, 10).Value + Cells(i, 10).Value
        End If
    Next j
Next i

'Hier wordt de delen van de codenamen vergeleken van kolo D en E en als
'de deelcodes hetzelfde zijn worden de afzet en de omzet van de codenamen bij mekaar opgeteld.
For i = 1 To 82
    For j = i + 1 To 83
        If Cells(j, 6).Value = Cells(i, 4).Value Then
            Cells(i + 1, 12) = Cells(j, 1).Value
            Cells(j, 1).Interior.ColorIndex = 3
            Cells(i + 1, 13) = Cells(j, 9).Value + Cells(i, 9).Value
            Cells(i + 1, 14) = Cells(j, 10).Value + Cells(i, 10).Value
        End If
    Next j
Next i

End Sub

Probleem wat nu ontstaat is dat de oorspronkelijke VBA code en de opgenomen macro niet met elkaar samengaan, en krijg ik een foutmelding. Ik zie niet wat het probleem is.Bekijk bijlage Sorteren en scheiden.xlsmBekijk bijlage Sorteren en scheiden.xlsm