• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

bepaalde cellen uit variabel aantal tabbladen onder elkaar zetten en ordenen.

Status
Niet open voor verdere reacties.
S

scartsjer

Gebruiker
Lid geworden
23 jan 2015
Berichten
34
Ik ben bezig met het maken van reserve onderdeel lijsten voor een groot project met een stuk of 100 machines.

ieder van deze 100 machines heeft een eigen tab met daar op gegevens van reserve onderdelen.

het kan voorkomen dat een bepaald onderdeel in 40 machines voorkomt

Nu wil ik een samenvattend tabblad maken die de waardes van cel a21:c80 & S21:S80 van elk tabblad onder elkaar zet. en van de dubbele onderdelen het aantal (kolom S) bij elkaar optelt. en maar 1 x weer geeft.

is dit mogelijk? het aantal machines moet kunnen variëren.
 

Bijlagen

Een bestand met 100 nagenoeg identieke tabbladen? Ga eens zoeken op tabellen en draaitabellen dat zal het geheel een stuk overzichtelijker houden.
 
Je bestandje iets gewijzigd aan de onderkant (tekst weggehaald) van je tabbladen 1.1 en 1.2.
Test het maar eens door op de knop te drukken.
 

Bijlagen

@Hsv, Mooi gemaakt blijft voor mij nog steeds een abracadabra die "Dictionary's":o Wel even, voordat de code begint met het wegschrijven van de gegevens, het doelbereik leegmaken:d

Even los van jouw oplossing blijf ik toch voorstander van het door mij in #2 aangehaalde punt.
 
Met Dictionary's werken is net zoals ik laatst tegen Johan Cruijff zei die mij vroeg hoe die bij Fc Groningen moest komen (oefenen, oefenen, oefenen........)
 
HSV zei:
Je bestandje iets gewijzigd aan de onderkant (tekst weggehaald) van je tabbladen 1.1 en 1.2.
Test het maar eens door op de knop te drukken.
Klik om te vergroten...

Harry bedankt! dit scheelt mij al 2 weken werk!

ik heb nog wel een paar vraagjes,
- Is het mogelijk om de gegenereerde tabel in een bepaalde opmaak te genereren? per item wil ik namelijk nog 3 kolommen met kostprijs aanbevolen hoeveelheid en een totaal prijs van het aanbevolen aantal units. onderaan de tabel wil ik dan nog een som van bovenstaande rijen in de kolom totaal prijs.

- Is er een manier om dit script de tabel te laten updaten? dus zodra ik een hoeveelheid verander op één van de tabbladen dat dit met een knop te updaten is.
 
Laatst bewerkt:
Twee weken?, dan moet je er wel heel blij van worden lijkt me.
Als je er maar niet werkeloos door wordt.

Zet de opmaak van 'summary' kolom A op tekst.
De code iets aangepast voor update.
Code: 
Private Sub CommandButton1_Click()
Dim oDic As Object, dic As Object, sh As Worksheet, sn, i As Long
Set oDic = CreateObject("Scripting.Dictionary")
Set dic = CreateObject("Scripting.Dictionary")
For Each sh In Sheets
 If sh.Name <> "Index" And sh.Name <> "Summary" Then
   sn = sh.Range("A21:S" & sh.Cells(Rows.Count, 1).End(xlUp).Row)
     For i = 1 To UBound(sn)
       oDic(sn(i, 1)) = oDic(sn(i, 1)) + sn(i, 19)
       If Not dic.exists(sn(i, 1)) Then dic(sn(i, 1)) = dic(sn(i, 1)) & sn(i, 2)
     Next i
  End If
 Next sh
With Sheets("Summary")
  .Range("A5:I" & Application.Max(5, .Cells(Rows.Count, 1).End(xlUp).Row)).ClearContents
  .Range("A5").Resize(oDic.Count, 3).Value = Application.Transpose(Array(oDic.keys, dic.items, oDic.items))
 End With
End Sub
 
HSV zei:
Twee weken?, dan moet je er wel heel blij van worden lijkt me.
Als je er maar niet werkeloos door wordt.

Zet de opmaak van 'summary' kolom A op tekst.
De code iets aangepast voor update.
Code: 
Private Sub CommandButton1_Click()
Dim oDic As Object, dic As Object, sh As Worksheet, sn, i As Long
Set oDic = CreateObject("Scripting.Dictionary")
Set dic = CreateObject("Scripting.Dictionary")
For Each sh In Sheets
 If sh.Name <> "Index" And sh.Name <> "Summary" Then
   sn = sh.Range("A21:S" & sh.Cells(Rows.Count, 1).End(xlUp).Row)
     For i = 1 To UBound(sn)
       oDic(sn(i, 1)) = oDic(sn(i, 1)) + sn(i, 19)
       If Not dic.exists(sn(i, 1)) Then dic(sn(i, 1)) = dic(sn(i, 1)) & sn(i, 2)
     Next i
  End If
 Next sh
With Sheets("Summary")
  .Range("A5:I" & Application.Max(5, .Cells(Rows.Count, 1).End(xlUp).Row)).ClearContents
  .Range("A5").Resize(oDic.Count, 3).Value = Application.Transpose(Array(oDic.keys, dic.items, oDic.items))
 End With
End Sub
Klik om te vergroten...

Gellukkig is het maken van deze lijst niet mn hoofd taak, normaliter engineer ik de machines alleen maar. Nu alleen bezig met het optimaliseren van de spare parts lijsten zodat dit in de toekomst minder werk kost.

De code die je me gaf geeft een fout namelijk
Fout 1004 tijdens uitvoering: U kunt niet een deel van een samengevoegde cel wijzigen
Klik om te vergroten...

De foutopsporing gaat naar deze regel:
Code: 
 .Range("A5:I" & Application.Max(5, .Cells(Rows.Count, 1).End(xlUp).Row)).ClearContents
 
Dan moet je geen cellen samenvoegen.
Vroeg of laat krijg je daar problemen mee.
Ik begrijp nog steeds niet dat dat onderdeel nog niet verdwenen is uit Excel.

Ps. niet quoten (citeren) op aansluitende vragen svp.
 
Prima, ik ga bezig met het updaten van de huidige werkbladen en haal de samengevoegde cellen er uit.

Bedankt voor de hulp!
 
Ik heb nog een paar probleempjes met de Dictionary code,

ik probeer een extra kolom mee te nemen namelijk het "type" kolom, echter lukt het mij niet

Ook zoek ik een manier om direct een where used cell bij ieder onderdeel te genereren met daar in de sheet names waar het onderdeel op voorkomt. bijv. "1.1 / 1.2 / 2.2"
 
Test het zo maar eens weer.
Code: 
private Sub CommandButton1_Click()
Dim oDic As Object, dic As Object, dic2 As Object, sh As Worksheet, sn, i As Long
Set oDic = CreateObject("Scripting.Dictionary")
Set dic = CreateObject("Scripting.Dictionary")
Set dic2 = CreateObject("Scripting.Dictionary")
For Each sh In Sheets
 If sh.Name <> "Index" And sh.Name <> "Summary" Then
   sn = sh.Range("A21:S" & sh.Cells(Rows.Count, 1).End(xlUp).Row)
     For i = 1 To UBound(sn)
       oDic(sn(i, 1)) = oDic(sn(i, 1)) + sn(i, 19)
       dic2(sn(i, 1)) = dic2(sn(i, 1)) & sh.Name & "/ "
       If Not dic.exists(sn(i, 1)) Then dic(sn(i, 1)) = dic(sn(i, 1)) & sn(i, 2)
     Next i
  End If
 Next sh
Sheets("Summary").Range("A5").Resize(oDic.Count, 4).Value = Application.Transpose(Array(oDic.keys, dic.items, oDic.items, dic2.items))
End Sub
 
Harry, Ik krijg bij alles wat ik probeer de volgende fout :
Fout 13 tijdens uitvoering: Typen komen niet met elkaar overeen.
Klik om te vergroten...

ik begrijp uit de code dat iedere Set dic = CreateObject("Scripting.Dictionary") de volgende kolom pakt Klopt dit?
 
Laatst bewerkt:
Het kijkt of in de eerste kolom de .key al bestaat, en daar komen je .items van de kolommen of bladnaam bij in.
Op welke regel komt de foutmelding.
 
Ik ben al een heel stuk verder!

hij vult nu netjes per onderdeel het type in!

verder is het mij gelukt om het eerste sheet waar het item voorkomt en het laatste sheet waar het item voorkomt weer te geven. echter lukt het mij nog niet om alle sheets naast elkaar te krijgen.

ook geeft hij zodra een item maar op één sheet voorkomt, dit sheet 2x weer... dit is ook niet de bedoeling ik probeer hier een count in te maken maar ik ben nog aan het puzzelen.

hier de code voorzover:
Code: 
Private Sub CommandButton1_Click()
Dim oDic As Object, dic2 As Object, dic3 As Object, dic4 As Object, dic5 As Object, sh As Worksheet, sn, i As Long
'Odic bevat het aantal van een item maar ook het item nummer
Set oDic = CreateObject("Scripting.Dictionary")
'dic2 bevat de item Description
Set dic2 = CreateObject("Scripting.Dictionary")
'dic3 Bevat het type
Set dic3 = CreateObject("Scripting.Dictionary")
'met dic 4 wordt de eerste sheet naam gevoden
Set dic4 = CreateObject("Scripting.Dictionary")
'dic5 voegd dic 4 samen met de laatste sheet naam
Set dic5 = CreateObject("Scripting.Dictionary")
For Each sh In Sheets
 If sh.Name <> "Index" And sh.Name <> "Summary" And sh.Name <> "Template" And sh.Name <> "Front" Then
   sn = sh.Range("A21:S" & sh.Cells(Rows.Count, 1).End(xlUp).Row)
     For i = 1 To UBound(sn)
       oDic(sn(i, 1)) = oDic(sn(i, 1)) + sn(i, 18)
       If Not dic2.exists(sn(i, 1)) Then dic2(sn(i, 1)) = dic2(sn(i, 1)) & sn(i, 2)
       If Not dic3.exists(sn(i, 1)) Then dic3(sn(i, 1)) = dic3(sn(i, 1)) & sn(i, 3)
       If Not dic4.exists(sn(i, 1)) Then dic4(sn(i, 1)) = sh.Name
       dic5(sn(i, 1)) = dic4(sn(i, 1)) & " / " & sh.Name
       Next i
  End If
 Next sh
Sheets("Summary").Range("A6").Resize(oDic.Count, 5).Value = Application.Transpose(Array(oDic.keys, dic2.Items, dic3.Items, dic5.Items, oDic.Items))
End Sub
 
Zet ook even het bestand hier neer met hoever je bent en wat je bedoeld.
Hier zet het netjes de bladnamen neer van de waarde.
Als het niet in een ander blad voorkomt wordt het ook niet meegenomen.
 
Met welk versie is dit gemaakt?
Helaas kan ik er geen code in uitvoeren.
De knoppen of aangemaakte subs geven alleen maar fouten.
Misschien even in een nieuw bestandje gieten.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan