Adresregel zo vaak herhalen als cijfer aangeeft.

[helion]

Hallo iedereen,

Ik heb een vraagje.
Is er een manier om hetvolgende te bereiken.

Ik heb een excelbestand met adresgegevens.
Nu moet elk adres een aantal pakketjes ontvangen.
Voor elk pakketje wil ik een sticker met adres uitdraaien.

Is er een manier (met formules) om het adres zo vaak onder elkaar te zetten als het cijfer daarachter aangeeft?
en dat dan het 2e adres daaronder verder gaat?

Voorbeeld:
Bekijk bijlage Voorbeeld.xlsx

 

[jkpieterse]

Zie bijlage...

 

[mvw64]

Misschien kan je er zo iets mee ?

 

[pasan]

Je vroeg om een formule maar misschien kun je hier ook iets mee.

Sub herhaling()
Dim BereikA()

 With Sheets("Blad1")
  bereikB = .Cells(1, 1).CurrentRegion
  .Cells(13, 1).CurrentRegion.ClearContents
  .Cells(13, 1) = "Gegevens"
  On Error Resume Next
   For i = 1 To UBound(bereikB)
    If i >= 3 Then
     ReDim BereikA(bereikB(i, 5), 3)
     
      For j = 0 To UBound(BereikA, 1)
       For jj = 1 To 4
        BereikA(j, jj - 1) = bereikB(i, jj)
       Next jj
      Next j
      
      Lrij = Range("A" & Rows.Count).End(xlUp).Row + 1
      .Cells(Lrij, 1).Resize(UBound(BereikA, 1), UBound(BereikA, 2) + 1) = BereikA
      Erase BereikA
    End If
   Next i
 End With
 
End Sub

 

[VenA]

Nog een andere mogelijkheid met VBA die de gegevens op blad2 wegschrijft.

Sub VenA()
ar = Sheets(1).Cells(1).CurrentRegion
ReDim ar1(Application.Sum(Columns(5)) - 1, 1 To 4)
For j = 2 To UBound(ar)
    For jj = 1 To ar(j, 5)
        For jjj = 1 To 4
            ar1(t, jjj) = ar(j, jjj)
        Next jjj
        t = t + 1
    Next jj
Next j
Sheets(2).[A2].Resize(UBound(ar1) + 1, 4) = ar1
End Sub

 

[snb]

als de 'tabel' in A1 begint:

Sub M_snb()
    sn = Cells(1).CurrentRegion
    
    For j = 2 To UBound(sn)
       c00 = c00 & Replace(String(sn(j, 5), " "), " ", " " & j)
    Next
    st = Application.Transpose(Split(Trim(c00)))
    
    Cells(20, 1).Resize(UBound(st), UBound(sn, 2) - 2) = Application.Index(sn, st, Array(1, 2, 3, 4, 5))
End Sub

 

[HSV]

Mooie code @snb,

Toch altijd mooi dat je ons altijd even een lesje leert hoe we het zelf aan kunnen passen om het correct werkend te zien. :thumb
Zoek de twee foutjes.......(aanpassingen).

 

[snb]

bedoel je ?

 

[HSV]

Het resultaat is een kolom te weinig.
Dus om het resultaat te verkrijgen moeten we wat aanpassen aan de code, zodat we ook weer mooi de werking ervan begrijpen.

Cells(20, 1).Resize(UBound(st), UBound(sn, 2) -[COLOR=#ff0000] 1[/COLOR]) = Application.Index(sn, st, Array(1, 2, 3, 4[COLOR=#ff0000] , 5[/COLOR])) ' [COLOR=#ff0000], 5 mag er dan ook nog af[/COLOR]

Vandaar mijn reactie.

 

[helion]

Wow, super!
hier kan ik wat mee.

Bedankt allen!!