Hoe opsomming verkrijgen van lijst met verschillende gegevens?

[mekanieker]

Beste lezers,

Ik zoek naar een code of functie in excel (liefst zonder VBA) om uit een lijst met gegevens een overzichtslijst te verkrijgen. Ik heb al met draaitafels geprobeerd maar kom er zo niet uit.

In bijlage vind je een voorbeeld van een lijst. De gegevens kunnen uitlopen tot 100 lijnen. De kleuren heb ik zo gezet zodat je de link ziet tussen de eerste en de tweede tabel.
Het is dus de bedoeling dat uit de eerste lijst alle aantallen van onderdelen met dezelfde eigenschappen automatisch worden opgeteld en worden weergegeven in de tweede lijst.
Is dit mogelijk? zoja kan iemand mij dit uitleggen?

Bekijk bijlage Voorbeeld.xlsx

Vriendelijke groeten!

 

[wampier]

Wil je de eigenschappen zelf ingeven, of verwacht je dat de tabel ook zelf alle unieke combinaties vindt? Het eerste geval is nog wel te doen vermoed ik (zeker met een hulpkolom). Het tweede scenario zou ik zelf gewoon in VBA doen, maar mogelijk zien anderen daar nog mogelijkheden.

 

[mekanieker]

Wampier, dank je voor je snelle antwoord!

Indien mogelijk is het de bedoeling dat de overzichtslijst zonder dat ik iets doe, wordt aangevuld naarmate de eerste lijst wordt aangevuld.
Kun je voor een leek uitleggen hoe je dit in VBA zou doen? Indien er geen andere oplossingen uit de bus komen zal ik mijn VBA cursus maar opnieuw doornemen en waar nodig mijn kennis trachten uit te breiden zodat ik het op die manier kan doen.

Vriendelijke groeten

 

[wampier]

Dit is de basiscode die ik zou gebruiken (alleen de originele tabel in het voorbeeld laten staan, niet de resultaat tabel)

Type opslag
    aantal As Long
    breedte As Long
    hoogte As Long
    dikte As Long
    bewerkt As String
    lasnaden As String
    uniek As String
End Type


Sub tellen()

Dim lijnen() As opslag
ReDim lijnen(1)
Dim id As String
Dim found As Boolean
For Each cell In Range([b3], [b50000].End(xlUp))
    id = cell.Offset(0, 1) & "x" & cell.Offset(0, 2) & "x" & cell.Offset(0, 3) & "x" & cell.Offset(0, 4) & "x" & cell.Offset(0, 5)
    found = False
    For i = 0 To (UBound(lijnen) - 1)
        If lijnen(i).uniek = id Then
            found = True
            lijnen(i).aantal = lijnen(i).aantal + cell.Value
        End If
    Next i
    If found = False Then
        lijnen(UBound(lijnen) - 1).aantal = cell.Value
        lijnen(UBound(lijnen) - 1).uniek = id
        ReDim Preserve lijnen(UBound(lijnen) + 1)
    End If
Next cell
ReDim Preserve lijnen(UBound(lijnen) - 1)
For i = 0 To UBound(lijnen) - 1
    MsgBox (lijnen(i).aantal & "   " & lijnen(i).uniek)
Next i
End Sub

Dit doet verder nog niets, behalve in msgboxes dezelfde resultaten tonen als je nu in je voorbeeld resultaat tabel hebt staan. Ik kan er nu niet verder aan werken, maar ik kan het voorbeeld morgen of zo nog wel verder uitwerken

 

[WHER]

Nog een voorbeeld van een VBA-aanpak.

 

[mekanieker]

Hartelijk dank allen,

Dit heeft me vooruit geholpen!

 

[mekanieker]

Nog een voorbeeld van een VBA-aanpak.

WHER, ik heb jou code proberen toe te passen in een ander document en dit lukt niet, kun je eens kijken wat ik verkeerd doe aub?

Vriendelijke groeten

Bekijk bijlage overzichtsmap(A)test.xlsm

 

[WHER]

Het ging op 3 plaatsen mis:
1: je code zat (mijns inziens) achter het verkeerde blad. De knop staat op blad "P12B0326", dus heb ik de code daarachter gehangen.
2:

arr = Range("D4:Q" & Cells(Rows.Count, 4).End(xlUp).Row)

For lng = 1 To UBound(arr)
  dic.Item(arr(lng, 5) & "|" & arr(lng, 6) & "|" & arr(lng, 7) & "|" & arr(lng, 8) & "|" & arr(lng, 9) _
  & "|" & arr(lng, 10) & "|" & arr(lng, 11) & "|" & arr(lng, 12) & "|" & arr(lng, 13) & "|" & arr(lng, 14) _
  & "|" & arr(lng, 15) & "|" & arr(lng, 16) & "|" & arr(lng, 17)) = dic.Item(arr(lng, 5) & "|" & arr(lng, 6) _
  & "|" & arr(lng, 7) & "|" & arr(lng, 8) & "|" & arr(lng, 9) & "|" & arr(lng, 10) & "|" & arr(lng, 11) _
  & "|" & arr(lng, 12) & "|" & arr(lng, 13) & "|" & arr(lng, 14) & "|" & arr(lng, 15) & "|" & arr(lng, 16) _
  & "|" & arr(lng, 17)) + arr(lng, 1)

Je verkrijgt een "arr" Variant/Variant(1 to 12, 1 to 14), dus kan arr(lng, 15) niet bestaan. Je verwart hier de positie (2e dimensie) binnen de matrix met het kolomnummer >> gevolg "Subscript out of range"

3:

Cells(lng + 3, 20).[COLOR="#FF0000"]Resize(, 5)[/COLOR] = Split(dic.Keys()(lng - 1), "|")

Je hebt eerst 13 elementen samengevoegd met het "|" karakter, bij het splitten heb je dus 13 kolommen nodig, dus "resize(, 13)"

 

[mekanieker]

Aanpassing VBA code

Beste,

In bijlage zit een nieuw documentje waarbij ik de code zou willen toepassen, ik heb deze proberen om te vormen om hierin te werken maar ik loop telkens vast.
Kan iemand me nog eens uit de nood helpen en hier en daar (waar het nu fout zit) een woordje uitleg geven zodat ik hier deftig mee kan werken, want het is wel een heel handige code die vaak toegepast kan worden.

Groeten,Bekijk bijlage test bouten en moeren.xlsm

 

[cow18]

waarom geen draaitabel ?

 

[mekanieker]

waarom geen draaitabel ?

Omdat ik hier de eerste keer niet mee kon werken, ^^
maar ik heb me er nog eens over geinformeerd en wat geprobeerd en heb er reeds spijt van dat ik me dit niet eerder aan heb geleerd.

Hartelijk dank