Lijst creeren in Excel

[PaulElst]

Ik heb een vraag hoe ik het beste een lijst kan creeren ik kom er niet uit.

ik heb het volgende

1ste kolom een artikel (art 1, art 2 en art 3)
2de kolom het aantal (2, 0 en 3
3de kolom een naam (klaas, piet, jan)

nu wil ik een rij maken waarin het volgende onder elkaar komt te staan.
klaas, klaas, jan, jan, jan

de aantallen van de artikelen dus onder elkaar maar dan met de naam. je ziet dat bij 0 niks komt te staan wie ook wie kan mij hierbij helpen.

Gr Paul

 

[E v R]

mbv dit macrootje, pas eventueel bereiken en werkbladnamen aan:

Sub NamenOnderElkaar()
    Dim cel As Range, namen As String, x As Long, namenlijst As Variant
    For Each cel In Sheets("Blad1").Range("a1:a3")
        For x = 1 To cel.Offset(0, 1).Value
            namen = namen & cel.Offset(0, 2).Text & "|"
        Next x
    Next cel
    namenlijst = Application.Transpose(Split(namen, "|"))
    Sheets("Blad1").Cells(1, 4).Resize(UBound(namenlijst)).Value = namenlijst
End Sub

 

[PaulElst]

Helemaal top dank je wel.
het werkt inderdaad goed.

thnx voor de snelle service:d

 

[Paul Elst]

extra vraag

Het werkt super! maar ik loopt nu tegen aan dat als een rij niet ingevuld is,
hij een foutmelding geeft.

namenlijst = Application.Transpose(Split(namen, "|"))

Wat moet ik in bovenstaande toevoegen als een rij alleen maar 0 waarden bevat.

hoor het graag

Gr Paul

 

[Warme bakkertje]

Daar zal je toch eens een voorbeeldbestandje moeten bijdoen, want ik rijen leeg laten of allemaal nullen in plaatsen en toch blijft het werken.

@ EvR
Waarom een extra variabele namenlijst ?

Sub NamenOnderElkaar()
    Dim cel As Range, namen As String, x As Long
    For Each cel In Sheets("Blad1").Range("a1:a3")
        For x = 1 To cel.Offset(0, 1).Value
            namen = namen & cel.Offset(0, 2).Text & "|"
        Next x
    Next cel
    Sheets("Blad1").Cells(1, 4).Resize(UBound(Split(namen, "|"))) _
                    .Value = Application.Transpose(Split(namen, "|"))
End Sub

 

[Paul Elst]

Hierbij het bestand waar het omgaat.
in de file zitten 2 marco's
de eerst werkt niet de tweede wel. dit komt omdat in de eerst rij geen aantallen staan


Sub ANNA()
Dim cel As Range, namen As String, x As Long, namenlijst As Variant
For Each cel In Sheets("PAKB A3").Range("a3:a239")
For x = 1 To cel.Offset(0, 1).Value
namen = namen & cel.Offset(0, 55).Text & "|"
Next x
Next cel
namenlijst = Application.Transpose(Split(namen, "|"))
Sheets("PAKB A3").Cells(3, 57).Resize(UBound(namenlijst)).Value = namenlijst
End Sub

Sub AP()
Dim cel As Range, namen As String, x As Long, namenlijst As Variant
For Each cel In Sheets("PAKB A3").Range("a3:a239")
For x = 1 To cel.Offset(0, 2).Value
namen = namen & cel.Offset(0, 55).Text & "|"
Next x
Next cel
namenlijst = Application.Transpose(Split(namen, "|"))
Sheets("PAKB A3").Cells(3, 58).Resize(UBound(namenlijst)).Value = namenlijst
End Sub[/TABLE]
Bekijk bijlage 120407Bekijk bijlage vraag.xlsx

 

[Warme bakkertje]

Sub ANNA()
Dim cel As Range, namen As String, x As Long, namenlijst As Variant
For Each cel In Sheets("PAKB A3").Range("a3:a239")
For x = 1 To cel.Offset(0, 1).Value
namen = namen & cel.Offset(0, 55).Text & "|"
Next x
Next cel
[COLOR="red"]If namen = "" Then Exit Sub[/COLOR]
Sheets("PAKB A3").Cells(3, 57).Resize(UBound(Split(namen, "|"))) _
                    .Value = Application.Transpose(Split(namen, "|"))

End Sub

 

[Paul Elst]

Thnx het werkt nu super