gegevens horizontaal naar verticaal + eigen tekens toevoegen

[huppelpaard]

Hoi ik ben aan een nieuwe uitdaging begonnen maar kom er niet uit

wat is mijn doel?
ik wil een printer label automatisch laten maken aan de hand van gegevens die ik krijg

Wat lukt wel?
ik kan via een hulptabblad de juiste gegevens overhouden om een label te maken en deze in tabblad printerblad laten verschijnen
ik gebruik hierbij wel een extra - teken die ik handmatig toevoeg in de formulebalk

Wat lukt niet?
als er meer dan 1 label gemaakt moet worden moet ik alle formules aanpassen bij elk volgende label (labels kunnen ook 100 zijn ipv 1 )

ik zat al te denken aan transponeren maar dan krijg ik niet de juiste opbouw.

Is dit wel te realiseren of denk ik gewoon te moeilijk?

 

[JEC.]

Selecteer eerst eens A1 t/m A4.

Trek vervolgens door. Al weet ik niet of je dit bedoelt.

 

[huppelpaard]

in a1 staat =HULPBLAD!A1
in a2 staat =HULPBLAD!B1&"-"&HULPBLAD!C1&"-"&HULPBLAD!D1
in a3 staat =HULPBLAD!E1&"-"&HULPBLAD!F1&"-"&HULPBLAD!G1

als ik a1 tm a4 door zou trekken dan staat in a5

=HULPBLAD!A5 terwijl dit =HULPBLAD!A2 zou moeten zijn -)

alle gegevens van printerlabel 1 staat in rij 1
alle gegevens van printerlabel 2 staat in rij 2
enz enz

doortrekken zal dus niet werken

nu moet ik dus in de volgende ..... handmatig aanpassen

HULPBLAD!A2
=HULPBLAD!B2&"-"&HULPBLAD!C2&"-"&HULPBLAD!D2
=HULPBLAD!E2&"-"&HULPBLAD!F2&"-"&HULPBLAD!G2

elk volgende label je raad het al ook hier weer handmatig de formule aanpassen

 

[JEC.]

Met een macro kan het ook. In je voorbeeld pakt hij een rij extra omdat er een formule in rij 11 van HULPBLAD staat. Als je die verwijdert klopt het
Het selecteren van je gevulde cellen zal vervolgens ook goed gaan.

Sub j_v()
jv = Sheets("HULPBLAD").Cells(1).CurrentRegion
 ReDim ar(UBound(jv) * 4)
 j = 0
  For i = 1 To UBound(jv)
   ar(j) = jv(i, 1)
   ar(j + 1) = Join(Array(jv(i, 2), jv(i, 3), jv(i, 4)), "-")
   ar(j + 2) = Join(Array(jv(i, 5), jv(i, 6), jv(i, 7)), "-")
   ar(j + 3) = ""
   j = j + 1 * 4
 Next
Sheets("printerblad").Cells(1).Resize(UBound(ar)) = Application.Transpose(ar)
End Sub

 

[VenA]

Zonder hulpblad kan ook

Sub VenA()
  ar = Sheets("gegevensblad").Cells(1).CurrentRegion.Resize(, 24)
  ReDim ar1(1 To 4 * UBound(ar))
    For j = 1 To UBound(ar)
      c00 = Split(ar(j, 1), "/")
      c01 = Split(ar(j, 3), "/")
      c02 = Split(ar(j, 9), "/")
      ar1(4 * (j - 1) + 1) = Left(c00(1), 3)
      ar1(4 * (j - 1) + 2) = c01(2) & "/" & c01(3) & "-" & ar(j, 4) & "-" & ar(j, 11) & "." & ar(j, 12)
      ar1(4 * (j - 1) + 3) = c02(2) & "/" & c02(3) & "-" & ar(j, 10) & "-" & ar(j, 17) & "." & ar(j, 18)
    Next j
  Sheets("printerblad").Cells(1, 2).Resize(UBound(ar1)) = Application.Transpose(ar1)
End Sub

Met een formule gaat het ook wel.

=IF(MOD(ROW();4)=1;INDEX(Help;ROUNDUP(ROW()/4;0);1);IF(MOD(ROW();4)=2;INDEX(Help;ROUNDUP(ROW()/4;0);2)&"-"&INDEX(Help;ROUNDUP(ROW()/4;0);3)&"-"&INDEX(Help;ROUNDUP(ROW()/4;0);4);IF(MOD(ROW();4)=3;INDEX(Help;ROUNDUP(ROW()/4;0);5)&"-"&INDEX(Help;ROUNDUP(ROW()/4;0);6)&"-"&INDEX(Help;ROUNDUP(ROW()/4;0);7);"")))

Help is een gedefinieerde naam van het bereik in jouw hulpblad aangezien je geen gebruik maakt van een tabel.

 

[huppelpaard]

dank je wel VenA en JVeer dit is precies wat ik bedoel

beide oplossingen werken :thumb: