Transponeren op basis van waarde in andere kolom

[globe]

Beste Helpmij-ers,

Ik heb een sheet met data waarvan er telkens 2 rijen relevant zijn. De rij 'Code' en 'aantal'

Is er een simpele manier om deze 2 rijen te transponeren op een nieuw of ander tabblad?

Problemen die ik tegenkom in de data zijn de volgende:
- per regel verschilt het aantal kolommen
- er kunnen meerdere (lege) regels tussen de verschillende 'groepjes' staan
- binnen de groepjes kan er ook irrelevante data staan of lege regels

Mijn idee is dus en formule (kan met LET functie, ik heb office 365) of VBA code te gebruiken waar in kolom A naar de omschrijving Code wordt gezocht, deze waarde naar een nieuw blad te kopieren, en vervolgens de waarde die in omschrijving Aantal staat hier achter te plakken.

Ik ben al aan de stoei geweest met x.zoeken, als, vergelijken etc. maar dit moet vast makkelijk kunnen

dank alvast voor het meedenken.

 

[AlexCEL]

Als je voorbeeld representatief is kan ik het met een behoorlijk aantal stappen in Power Query omzetten naar het gewenste resultaat....

 

[globe]

Dit is idd het gewenste resultaat.

Zou dit ook in een macro verwerkt kunnen worden denk je?
Ik ga namelijk 100-den formulieren retour krijgen die ik als versimpelde versie wil kunnen bewerken.

 

[JEC.]

Vind je deze weergave niets?

=TEKST(TRANSPONEREN(FILTER(A1:H10;A1:A10<>""));"0;;")

 

[globe]

JEC,

dat is al een mooi begin, maar het eindresultaat moeten echt 2 kolommen worden.

Kolom A code en Kolom B aantal.

Dus als er nog een mogelijkheid is om samen te voegen ben ik een eind op weg. Nu staan er 3 'groepjes' maar in het 'echte' bestand kunnen dit er 100-den zijn.

 

[AlexCEL]

Complexe formules, maar zoiets wellicht?

[M2] =LET(M;FILTER(B1:H10;A1:A10="code";"");rM;RIJEN(M);cM;KOLOMMEN(M);c;REEKS(rM*cM;1;0);x;INTEGER(c/cM)+1;y;REST(c;cM)+1;z;INDEX(M;x;y);FILTER(z;z>0;""))
[N2] =LET(M;FILTER($B$1:$H$10;$A$1:$A$10="code";0);A;FILTER($B$1:$H$10;$A$1:$A$10="aantal";0);SOMPRODUCT((M=M2)*A))

De tweede moet je doortrekken naar onder. Bereiken aanpassen naar behoefte.

 

[JEC.]

Hier ook nog een VBA optie. Zorg eerst dat je je voorbeeld output even verwijdert uit sheet1 voordat je de code runt. Dus alleen de brondata overhouden

Sub jec()
 Dim ar, d, sq, j As Long, jj As Long, jjj As Long, x As Long
 ar = Sheets(1).UsedRange
 Set d = CreateObject("scripting.dictionary")
 
 For j = 1 To UBound(ar)
    If Len(ar(j, 1)) Then d(d.Count) = Application.Index(ar, j)
 Next
 ReDim sq(d.Count * UBound(ar, 2), 1)
 For jj = 0 To d.Count - 1 Step 2
    For jjj = 2 + (jj = 0) To UBound(d(jj))
      If Len(d(jj)(jjj)) Then
        sq(x, 0) = d(jj)(jjj)
        sq(x, 1) = d(jj + 1)(jjj)
        x = x + 1
      End If
    Next
 Next
 
 Sheets(2).Range("A1").Resize(x, 2) = sq
End Sub

 

[JEC.]

@Alex, heb die van jou iets aangevuld zodat je het met één formule af kan

=LET(rng;B1:H10;col;A1:A10;M;FILTER(rng;col="code");A;FILTER(rng;col="aantal");rM;RIJEN(M);cM;KOLOMMEN(M);c;REEKS(rM*cM;1;0);x;INTEGER(c/cM)+1;y;REST(c;cM)+1;out;KIEZEN({1\2};INDEX(M;x;y);INDEX(A;x;y));FILTER(out;INDEX(out;;1)<>0))

 

[AlexCEL]

Was ernaar op zoek maar wegens tijdgebruik eventjes niet gevonden... :thumb:

 

[globe]

Beiden waanzinnig bedankt voor de oplossingen:

@ JEC, de VBA oplossing zou de mooiste oplossing zijn denk ik maar deze loop spaak wanneer er irrelevante data tussen de 'groepjes' staat. Er wordt niet gekeken naar Code en Aantal. maar de gehele sheet wordt getransponeerd. Ik zou hier evt een filter voor kunnen zetten wat de overige data weghaalt.

@ JEC en Alexcel: de LET functie werkt top maar hier staat een bereik in aangegeven. De breedte van de data zal gelijk zijn maar de lengte niet. Kan hier een variabel bereik worden aangegeven?

 

[AlexCEL]

Maak je het bereik toch groter?

=LET(rng;B1:[COLOR="#FF0000"]H10000[/COLOR];col;A1:[COLOR="#FF0000"]A10000[/COLOR];M;FILTER(rng;col="code");A;FILTER(rng;col="aantal");rM;RIJEN(M);cM;KOLOMMEN(M);c;REEKS(rM*cM;1;0);x;INTEGER(c/cM)+1;y;REST(c;cM)+1;out;KIEZEN({1\2};INDEX(M;x;y);INDEX(A;x;y));FILTER(out;INDEX(out;;1)<>0))

 

[globe]

Sub jec()

Application.DisplayAlerts = False

Worksheets("Blad1").Range("A:A").AutoFilter Field:=1, Criteria1:="<>code", Operator:=xlAnd, Criteria2:="<>aantal"

ActiveSheet.AutoFilter.Range.Offset(1, 0).Rows.SpecialCells(xlCellTypeVisible).Delete

Rows(1).Delete


 Dim ar, d, sq, j As Long, jj As Long, jjj As Long, x As Long
 ar = Sheets(1).UsedRange
 Set d = CreateObject("scripting.dictionary")
 
 For j = 1 To UBound(ar)
    If Len(ar(j, 1)) Then d(d.Count) = Application.Index(ar, j)
 Next
 ReDim sq(d.Count * UBound(ar, 2), 1)
 For jj = 0 To d.Count - 1 Step 2
    For jjj = 2 + (jj = 0) To UBound(d(jj))
      If Len(d(jj)(jjj)) Then
        sq(x, 0) = d(jj)(jjj)
        sq(x, 1) = d(jj + 1)(jjj)
        x = x + 1
      End If
    Next
 Next
 
 Sheets(2).Range("A1").Resize(x, 2) = sq
End Sub

en ook jouw oplossing werkt top AlexCEL. Hier kan ik wel verder mee.

 

[JEC.]

Probeer deze dan eens in mijn code aan te passen.
Waarschijnlijk de aanhalingstekens even vervangen door windows aanhalingstekens. Deze komen van een Iphone (om code en aantal)

If ar(j, 1) = “code” or ar(j, 1) = “aantal” Then d(d.Count) = Application.Index(ar, j)

 

[snb]

Sub M_snb()
  Sheet1.Columns(1).SpecialCells(4).EntireRow.Delete
  sn = Sheet1.Cells(1).CurrentRegion
  ReDim sp(UBound(sn) * UBound(sn, 2) \ 2, 1)
   
  For j = 1 To UBound(sn) Step 2
    For jj = 2 To UBound(sn, 2)
      If sn(j, jj) <> "" Then
        sp(n, 0) = sn(j, jj)
        sp(n, 1) = sn(j + 1, jj)
        n = n + 1
      End If
    Next
  Next
   
  Sheet2.Cells(1).Resize(UBound(sp) + 1, UBound(sp, 2) + 1) = sp
End Sub

 

[globe]

top JEC!

Mijn oplossing hierboven werkte ook maar de jouwe is nog wat sjieker.

Ik ga aan de klus. Waarschijnlijk meld ik me morgen wel weer aangezien ik vrees dat deze functie over meerdere sheets moeten worden uitgevoerd.
En er zal waarschijnlijk de wens komen voor open file dialog.

 

[HSV]

Veel eenvoudiger dan de LET functie lijkt me.

=FILTER(KIEZEN({1\2};NAAR.KOLOM(FILTER(B1:H10;A1:A10="code"));NAAR.KOLOM(FILTER(B1:H10;A1:A10="aantal")));(NAAR.KOLOM(FILTER(B1:H10;A1:A10="code"))>0)+(NAAR.KOLOM(FILTER(B1:H10;A1:A10="aantal")))>0)

 

[JEC.]

Die werkt alleen in de beta versie.

Je ziet meerdere terugkomende delen in de formule. Die FILTER delen (of zelfs de NAAR.KOLOM delen) zou je dan in een LET zetten. Daarmee voorkom je dat je telkens hetzelfde ziet terugkomen.

 

[HSV]

Heb geduld, komt vanzelf.

Door de LET functie wordt het inderdaad een stukje korter.
Jammer dat er geen tussentijdse evaluatie mogelijk is, maar dat zal hoop ik te zijner tijd wel aangepast worden.

=LET(rng;A1:A10;col;B1:H10;F_1;NAAR.KOLOM(FILTER(col;rng="code"));F_2;NAAR.KOLOM(FILTER(col;rng="aantal"));FILTER(KIEZEN({1\2};F_1;F_2);(F_1>0)+(F_2>0)))