Overzicht transformeren

[Excellies]

Hallo,

Momenteel zit ik met een overzicht te stoeien omdat het niet juist is ingedeeld en ik hoop dat jullie mij hierbij kunnen helpen.

Het gewenste resultaat zou zijn kolom A alle dikgedrukte waarden met daarnaast de onderstaande waarden. (Zie tabblad 'voorbeeld')
Zelf heb ik al het e.e.a. geprobeerd middels transponeren en draaitabellen maar dit geeft helaas niet het gewenste resultaat.

Ben benieuwd hoe jullie dit aanvliegen.

 

[AlexCEL]

Met Power Query is dit wel te doen.

*bijlage weggeknipt*

 

[snb]

Aanvliegen, zó:

- vraag je af waarin de vetgedrukte elementen systematisch afwijken van de niet-vetgedrukte
- gebruik dit kenmerk om de verschillende elementen op een eigen onderscheiden positie te zetten
- gebruik hiervoor een array (want dat is een werkblad uiteindelijk ook)

Sub M_snb()
  sn = Sheet1.Cells(1).CurrentRegion.Columns(1).Resize(, 40)
  
  For j = 1 To UBound(sn)
    If Left(sn(j, 1), 2) = "UR" Then
      y = j
      n = 2
    Else
      sn(y, n) = sn(j, 1)
      sn(j, 1) = ""
      n = n + 1
    End If
  Next
  
  Cells(1, 10).Resize(UBound(sn), 40) = sn
End Sub

 

[Excellies]

Thanks AlexCel & SNB dit is exact wat ik nodig had.
De code van SNB is qua opzet voor mij net iets handiger maar petje af voor allebei!

 

[AlexCEL]

Ik ontdekte nog wel wat foutjes, dus heb bijlage verwijderd. Ik filterde op "UR-" maar er zijn ook codes bij als "UKR". Dat ging niet goed...
Bij deze volgens mij een correcte versie.

 

[snb]

Nog een alternatief:

Sub M_snb_001()
  n = 1
  With Sheet1.Cells(1).CurrentRegion.Columns(1)
    .AutoFilter 1, "UR*"
    .Copy .Cells(1, 4)
    .AutoFilter
    .AutoFilter 1, "* *"
    For Each it In .SpecialCells(12).Areas
      .Cells(n, 5).Resize(, it.Count) = Application.Transpose(it)
      n = n + 1
    Next
    .AutoFilter
  End With
End Sub