Gegevens meerdere keren kopieeren met toevoeging van een uniek nummer

[roelteeninga]

Hallo,

Ik ben bezig een standaard blad / invulblad te maken voor deuren en kozijnen.
in een invoerscherm zoals op het blad kunnen de gegevens ingevuld worden per woningtype.
vervolgens heb ik 58 woningen in 8 woningtypes. Waarbij nummer 1 tot 58 elke keer staat voor 1 van die 8 woningtypes.

Nu krijg ik de gegevens per woningtype wel op het blad Overzicht totaal, maar ik wil dat ik van elk bouwnummer kan zien welke kozijnen daar komen, zie voor de eindsituatie het blad Eindsituatie, (dit is een deel .. het moet dus doorlopen tot bouwnummer 58)

Is dit te programmeren ?? het aantal rijen kan dus variabel zijn, net als het aantal verschillende woningtype en het totaal aantal woningen ..
Ik ben dr aardig wat uurtjes mee bezig geweest maar ik kom dr niet ...

k ben benieuwd

 

[popipipo]

Hallo Roel

Het verschil in de twee tabbladen Totaal overzicht en Eindsituatie is dat in het tabblad eindsituatie één kolom meer zit nl bouwnr
en dit bouwnr komt steeds overeen met woning type.
1=W
2=A1k
3=Ah
En je spreekt over een uniek nr, bedoel je hier toch het bouwnr?
Wat exact wil je nu geautomatiseerd hebben?
De twee tabbladen zijn toch (bijna) gelijk kolom A en C zijn immers gelijk.

 

[roelteeninga]

hallo,

Wat ik geautomatiseerd wil hebben is dat woningtype W 4x voorkomt (van de 58) en W1 ook 4x.

Ik wil per woningtype het 1x invoeren en daarna moet automatisch ingesteld worden dat hij voor bouwnummer 1,17,31 en 45 de tien regels van woningtype W kopieert .. maar wel op volgorde van bouwnummer.

maar hoe vaak een woningtype voorkomt, hoeveel woningen het totaal zijn en het aantal regels (merken) per woningtype is variabel ...

hopelijk is dit genoeg info..

 

[popipipo]

Hallo Roel

Dmv (8)commandbuttons kopieert hij de regels van tabblad 'Overzicht totaal' naar tabblad 'Eindsituatie'
Alleen de verhoging van bouwnr is nog niet rond.
Misschien dat jij of iemand anders daar nog een idee over heeft.
Ik hoop dat dit je bedoeling was.

 

[roelteeninga]

Dit idee is inderdaad wel de bedoeling, maar de woningtypes en hun codereing (W. W1 A1ks enz) kan variabel zijn de volgende x dat ik het programa ga gebruiken .. dat is vooral het punt waarop ik vastloop ..

 

[roelteeninga]

Hallo Roel

Dmv (8)commandbuttons kopieert hij de regels van tabblad 'Overzicht totaal' naar tabblad 'Eindsituatie'
Alleen de verhoging van bouwnr is nog niet rond.
Misschien dat jij of iemand anders daar nog een idee over heeft.
Ik hoop dat dit je bedoeling was.

Ik ben niet zo heel bekend met excel - vba dus ik vroeg me af hoe deze regel werkt "Application.Goto Reference:="a1k" " en hoe je dus die referentie aangeeft...

 

[Wigi]

Ik ben niet zo heel bekend met excel - vba dus ik vroeg me af hoe deze regel werkt "Application.Goto Reference:="a1k" " en hoe je dus die referentie aangeeft...

Met die regel sprint Excel naar het bereik (eender waar in het bestand) waarvan de naam a1k is.

Wigi

 

[roelteeninga]

okee, en hoe geef je zo'n bereik dan aan ?

 

[Wigi]

okee, en hoe geef je zo'n bereik dan aan ?

Invoegen > Naam > Definiëren

 

[roelteeninga]

Ik heb nu deze code warbij hij het woningtype wat je gegeven hebt als naam voor het bereik gebruikt

ActiveSheet.Cells.Find(What:=Sheets("Invoer scherm").Range("B2"), After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate

ActiveWorkbook.Names.Add Name:=Sheets("Invoer scherm").Range("B2"), RefersToR1C1:=ActiveCell
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
Selection.AutoFilter

Probleem zit hem in het selecteren van het bereik, dit wil ik doen door naar de laatste gevulde rij en kolom te gaan, maar hij neemt nu alleen de actieve cel mee in het bereik ...

 

[roelteeninga]

zelf al opgelost .. eerst selectie laten maken en dan van die selectie het bereik maken ..

blijft voor mij alleen de vraag staan hoe ik aan de hand van de lijst met bouwnummers - woningtypes de verschillende bereiken kan aanroepen ..

 

[Demeter]

Kan je eventueel posten wat je to nu toe hebt gemaakt?
Kijkt wat makkelijker mee ipv je oude file + alle antwoorden erin verwerken

 

[roelteeninga]

Dit is het tot nu toe ..

 

[Demeter]

Probeer deze code eens + uitleg (er komt nu ook in kolom Y een uniek nummer te staan, deze kan je aanpassen aan je eisen )

Sub aaaaaaa()
Dim c As Range
Dim laatsteregel, laatsteregelInvoer As Long
Dim legeregel, legeregelEind As Long
Dim teller As Long

Application.ScreenUpdating = False

    'vul de variabele teller, voor het aangeven van een uniek nummer in kolom Y
    teller = 1

    'eerst blad leegmaken
    legeregel = Sheets("Eindsituatie").Range("A65536").End(xlUp).Row + 1
    Sheets("Eindsituatie").Range("A3:Y" & legeregel).ClearContents

    'range bepalen voor de 1e loop, je bouwnummers
    laatsteregelInvoer = Sheets("Invoer scherm").Range("G65536").End(xlUp).Row
    For Each c In Sheets("Invoer scherm").Range("G3:G" & laatsteregelInvoer)
        'als deze niet leeg is dan de volgende code
        If c <> "" Then
        
            'zoekterm vullen (werk wat overzichtelijker dan direct in je find programmeren, is wel iets meer code
            zoekterm = c.Offset(, 1).Value
            
            'laatste gevulde regel zoeken op blad Overzicht totaal
            laatsteregel = Sheets("Overzicht totaal").Range("A65536").End(xlUp).Row
            
            'je bereik bepalen waarin we de zoekterm gaan zoeken
            With Sheets("Overzicht totaal").Range("A3:A" & laatsteregel)
                'zet de eerste gevonden cel met de zoekterm zodat we deze kunnen gebruiken om het begin van de loop te bepalen
                Set d = .Find(zoekterm, LookIn:=xlValues, MatchCase:=True, LookAt:=xlWhole)
                If Not d Is Nothing Then
                    'variabele declareren welke de 1e gevonden cel onthoudt
                    firstAddress = d.Address
                    'voor de volgende code uit als er een d is
                    Do
                        'legeregel bepalen om naar te kopieeren
                        legeregel = Sheets("Eindsituatie").Range("A65536").End(xlUp).Row + 1
                        'vul eerst de eerste cel van je lege regel met je bouwnummer
                        Sheets("Eindsituatie").Range("A" & legeregel) = c.Value
                        'kopieer de 1e 22 cellen op de regel waarop je zoekterm gevonden is naar het blad Eindsituatie
                        d.Resize(1, 22).Copy Sheets("Eindsituatie").Range("B" & legeregel)
                        Sheets("Eindsituatie").Range("Y" & legeregel) = teller
                        'verhoog de teller met 1
                        teller = teller + 1
                        'vul de met de nieuwe cel waarin de zoekterm staat
                        Set d = .FindNext(d)
                    'is er geen nieuwe cel of is deze cel de 1e welke gevonden was, sluit dan de loop
                    Loop While Not d Is Nothing And d.Address <> firstAddress
                End If
            End With
            
        End If
    Next
    
    'lege regel bepalen om het gevulde bereik te bepalen
    legeregelEind = Sheets("Eindsituatie").Range("A65536").End(xlUp).Row + 1
    
    'ga naar blad Eindsituatie
    Sheets("Eindsituatie").Activate
    'selecteer het gevulde bereik
    Sheets("Eindsituatie").Range("A3:X" & legeregelEind).Select
    'soreteer het geselecteerde bereik
    Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Key2:=Range("B3") _
        , Order2:=xlAscending, Key3:=Range("C3"), Order3:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, Orientation:=xlTopToBottom
    
    'selecteer cel A1
    Sheets("Eindsituatie").Range("A1").Select

Application.ScreenUpdating = True

End Sub

Edit:
Code regel toegevoegd:

Sheets("Eindsituatie").Activate

 

[roelteeninga]

helemaal goed .. ik krijg in ieder geval alle gegegevens op het blad ...
krijg alleen nog een fout melding in

    'selecteer het gevulde bereik
    Sheets("Eindsituatie").Range("A3:X" & legeregelEind).Select

 

[Demeter]

Ik zie het. Dit gebeurt als je vanaf een ander blad de code laat lopen.

Code aangepast.

 

[Demeter]

Code weer iets aangepast, .find functie uitgebreidt zodat deze alleen zoekt naar de juiste waarde in de cel.

 .Find(zoekterm, LookIn:=xlValues, MatchCase:=True, LookAt:=xlWhole)

 

[roelteeninga]

Hij deed het goed ..
maar nu gooit ie de boel wat door elkaar .. zie bijgevoegd bestand ..

W en W1 hebben allebei bouwnummer 1 ..
net als A1ks en A1k die allebei bouwnummer 2 hebben..

verder krijg k ook nog weer n fout bij t sorteren ..

heel vaag .. :S

 

[popipipo]

Hallo Roel

Je hebt dezelfde vraag al gesteld op een ander forum daar heb je al diverse antwoorden gekregen

Vermeld dat aub ook niet alleen hier maar ook in het andere forum.
Het wiel hoeft niet opnieuw uitgevonden te worden.

Willem

 

[roelteeninga]

na de laatste aanpassing van jou (met .Find) doet ie t weer goed .. op t sorteren na ..