Automatisch regels expanderen

[ianb]

Hallo,

Ik moet vaak onderdeel lijsten maken om de onderdelen te kunnen labellen, met het labelling. Nu is het geval dat elk deeltje individueel gelabeld moet worden. Uit het SAP systeem komen de regels met de totalen genoemd, bijvoorbeeld:

Onderdeel nr.---aantal-----benaming
123123-----------------3---------Pakking

Nu moet ik per onderdeel een label hebben en een label met het totaal aantal:

Onderdeel nr.---aantal-----benaming
123123-----------------3---------Pakking
123123-----------------1---------Pakking
123123-----------------1---------Pakking
123123-----------------1---------Pakking


Is het mogelijk om dit door excel te laten doen? Nu moet handmatig alle stuks regels toevoegen, en dat kost veel tijd omdat de lijsten soms nog al lang kunnen zijn.

Bedankt voor jullie hulp.

Groet,

Ian

 

[Roncancio]

Onderstaande code zet de waarde om aan de hand van de gegeven aantallen.
Bijv.:

123123 3 Pakking
123124 2 Pakking
test test test
doei doei doei
123125 5 Pakking

Wordt...

[B]123123 3 Pakking[/B]
123123 1 Pakking
123123 1 Pakking
123123 1 Pakking
123124 2 Pakking
123124 1 Pakking
123124 1 Pakking
test test test
doei doei doei
123125 5 Pakking
123125 1 Pakking
123125 1 Pakking
123125 1 Pakking
123125 1 Pakking
123125 1 Pakking

De vette rode waardes zijn de oorspronkelijke regels.

De code gaat ervan uit dat de gegevens in de kolommen A, B en C staan.
De code is als volgt:

Sub Expanderen()
Dim lRij As Long
Dim lERij As Long
Dim lTeller As Long
    lRij = 1
    lERij = Range("A65536").End(xlUp).Row
    While lRij <= lERij
        If IsNumeric(Range("B" & lRij).Value) Then
            Range("A" & lRij + 1 & ":A" & lRij + Range("B" & lRij)).EntireRow.Insert
            For lTeller = 1 To Range("B" & lRij)
                Range("A" & lRij + lTeller).Value = Range("A" & lRij)
                Range("B" & lRij + lTeller).Value = 1
                Range("C" & lRij + lTeller).Value = Range("C" & lRij)
            Next
            lERij = Range("A65536").End(xlUp).Row
            lRij = lRij + Range("B" & lRij) + 1
        Else
            lRij = lRij + 1
        End If
    Wend
End Sub

Met vriendelijke groet,


Roncancio

 

[ianb]

Hallo,

Bedankt voor je snelle reactie!

Zoals je hieronder weergeeft is precies wat ik bedoel. Alleen ik heb niet de soort regels als "test test test" en "doei doei doei". Alleen hoe krijg ik het werkend, is dit een add-in ofzo? Als ik het in een cel plakt ziet hij het niet als formule. En is deze ook geschikt voor Engelstalige software? En als ik al een excel sheet heb met alleen de totalen, voegt hij dan zelf de rijen met de per stuk aantallen automatisch in?

Sorry, misschien had ik dat over engelstalige versie excel eerder moeten zeggen, maar vergeten

Nogmaals bedankt.

Groet,

Ian

 

[Roncancio]

Sorry, misschien had ik dat over engelstalige versie excel eerder moeten zeggen, maar vergeten

Nah, dat maakt niet uit. Ook voor de code niet.

Ga naar
- Extra - Macro - Visual Basic Editor (ALT-F11)
- Beeld - Projectverkenner (CTRL-R)
- Plak de code erin.
- Klik op F5.

Voor de volledigheid heb ik een leeg bestand bijgevoegd met deze macro.
De macro heet dus Expanderen.

Als er nog vragen zijn, dan hoor ik het wel.

Met vriendelijke groet,


Roncancio

 

[ianb]

Haha!! Hij werkt :thumb:

Dit gaat mij heel veel tijd schelen

Bedankt voor je hulp!

Groet,

Ian