unieke waarden uit een kolom in een rij plaatsen

[herbertbosch]

Beste Helpmij forumleden,

Ik heb al een tijd gezocht, maar geen eenvoudige oplossing kunnen vinden voor het volgende:
Ik wil uit een Excel lijst de unieke waarden waarden in een rij weergeven.

Ik ben op zoek naar een eenvoudige manier om alle unieke waarden uit de kolom in 1 rij te krijgen.
Bijgaand treffen jullie een voorbeeldbestand aan.
Ik heb het eerst geprobeerd door het "gewoon" in een kruistabel te zetten (via een draaitabel), maar dan krijgen je enorm veel kolommen die veelal leeg zijn.

Erg benieuwd naar jullie antwoorden, als er vragen zijn: stel ze gerust

 

[snb]

Je kunt beginnen met:

Sub M_snb()
    sn = Cells(9, 1).CurrentRegion
    
    With CreateObject("scripting.dictionary")
      For j = 1 To UBound(sn)
         .Item(sn(j, 1)) = .Item(sn(j, 1)) & ";" & sn(j, 2)
      Next
      Cells(1, 1).Resize(.Count) = Application.Transpose(.keys)
      Cells(1, 2).Resize(.Count) = Application.Transpose(.items)
      Cells(1, 2).Resize(.Count).TextToColumns , , , , True, True, True, True, True
   End With
End Sub

 

[herbertbosch]

Bedankt snb,

Dit werkt inderdaad prima!

Kan ik dit ook gemakkelijk gebruiken bij bestanden met langere rijen?
Wat moet ik dan eventueel aanpassen?

 

[herbertbosch]

snb,

Kan ik dit ook zo regelen, dat de macro de data in een volgend tabblad weergeeft?

 

[snb]

Als je in de macro aangeeft in welk werkblad 'wat staat'/'dient te komen' loopt alles gesmeerd.
'Langere rijen' zijn geen probleem (zie de hulpbestanden van de VBEditor bij 'currentregion'); je moet eventueel het adres van de eerste cel (in jouw voorbeeld A9 (=cells(9,1)) aanpassen.

Sub M_snb()
    sn = sheets("[COLOR="#FF0000"]Blad1[/COLOR]").Cells(9, 1).CurrentRegion
    
    With CreateObject("scripting.dictionary")
      For j = 1 To UBound(sn)
         .Item(sn(j, 1)) = .Item(sn(j, 1)) & ";" & sn(j, 2)
      Next
      with Sheets("[COLOR="#FF0000"]Blad2[/COLOR]")
          .Cells(1, 1).Resize(.Count) = Application.Transpose(.keys)
          .Cells(1, 2).Resize(.Count) = Application.Transpose(.items)
          .Cells(1, 2).Resize(.Count).TextToColumns , , , , True, True, True, True, True
      end with
   End With
End Sub

 

[herbertbosch]

Bedankt voor de snelle reactie. Ik ga direct aan de slag.

 

[herbertbosch]

snb,

Ik krijg bij deze regel een foutmelding:
Foutmelding is: Fout 438 tijdens uitvoering: Deze eigenschap of methode wordt niet ondersteund door dit object

Hij geeft aan dat het bij deze regel fout gaat:
.Cells(1, 1).Resize(.Count) = Application.Transpose(.keys)

Enig idee waardoor dit komt, of hoe dit op te lossen?

 

[WHER]

Probeer deze aangepaste versie eens.

Sub M_snb()
    sn = Cells(9, 1).CurrentRegion
    
    With CreateObject("scripting.dictionary")
      For j = 1 To UBound(sn)
         .Item(sn(j, 1)) = .Item(sn(j, 1)) & ";" & sn(j, 2)
      Next
      mycount = .Count: mykeys = .keys: myitems = .items
      With Sheets("Blad2")
      .Cells(1, 1).Resize(mycount) = Application.Transpose(mykeys)
      .Cells(1, 2).Resize(mycount) = Application.Transpose(myitems)
      .Cells(1, 2).Resize(mycount).TextToColumns , , , , True, True, True, True, True
      End With
   End With
End Sub

 

[herbertbosch]

WHER dank voor het meedenken.

Met jouw toevoeging is het helaas ook nog niet gelukt.

Ik krijg nu de foutmelding: fout 13 tijdens uitvoering. Typen komen niet met elkaar overeen. Bij foutopsporing maakt hij geel: For j = 1 To UBound (sn).

Nog suggesties wat nu te doen?

 

[snb]

Plaats je macro en je werkboek hier, hoeven we niet zo te gissen.

Heb je de suggestie uit #5 wel doorgevoerd ?
Heb je de namen van de werkbladen gecontroleerd en aangepast ?