Unieke waarden kopieren, dubbele waarden niet kopieren

[ZZ1]

Hallo,


Ben op dit moment erg aan het stoeien met een excel bestandje waarmee ik het één en ander mee wil creeeren.
Zie voorbeeld bestandje "test"
Hierin heb ik in Kolom A diverse teksten ingeplaatst, hiervan wil alle identieke namen welke erin staan, en deze graag ik kolom B terugzien.
In het voorbeeld bestandje heb ik circa 100 teksten toegevoegd.
Maar het orginele bestand bestaat circa uit 3000 teksten, welke doorgespit moet worden.
Met alle identieke benaming.

Heb op het forum al wat gevonden, dat werkt ook.
Alleen als ik deze code uitbreid tot 3000 regels werkt hij niet meer.

=ZOEKEN("zzzzz";KIEZEN({1\2};"";INDEX($A$2:$A$100;VERGELIJKEN(0;AANTAL.ALS(E$1:E1;$A$2:$A$100);0))))

Iemand die mij hierin kan verlossen?

 

[Niels28]

Kan ook met een macro:

Sub ontdubbelen()
With Sheets("test")
For Each cl In .Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
If InStr(c01, cl.Value) = False Then c01 = c01 & "|" & cl.Value
Next
.Cells(1, 2).Resize(UBound(Split(c01, "|"))) = Application.Transpose(Split(Mid(c01, 2), "|"))
End With
End Sub

Niels

 

[WHER]

ZZ1,
Voor zover ik het zie heb je twee opties:
Je gebruikt de macro van Niels (=snel en efficient over 3000 rijen)
Je gebruikt de formule, op een correcte manier uitgebreid tot 3000 rijen (engelstalige versie):

=LOOKUP("zzzzz";CHOOSE({1\2};"";INDEX($A$2:$A$3000;MATCH(0;COUNTIF(E$1:E1;$A$2:$A$3000);0))))

deze voer je in in cel E2 (nergens anders!) als matrixformule (ctrl+shift+enter i.p.v. enter) en sleep je vervolgens naar beneden. Getest in jouw voorbeeld werkt dit, wel iets trager als een macro.

 

[ZZ1]

Harstikke bedankt voor beide reacties
Niels28 & WHER.

Ik zal de macro van Niels28 gaan gebruiken, alleen probeer ik hiervoor nog een extra loop in te schrijven.
Omdat deze macro nu geschreven is voor Kolom "A".
Maar ik heb heel veel kolommen waar deze macro voor nodig is.
De teksten gaan tot kolom "BL" op dit moment.

Kan hiervan ook een loop geschreven worden?

 

[Warme bakkertje]

Maak een extra werkblad aan genaamd Samenvatting.

Sub ontdubbelen1()
With Sheets("test")
For i = 1 To 64
    For Each cl In .Range(.Range(.Cells(1, i).Address), .Range(.Cells(Rows.Count, i).End(xlUp).Address))
        If InStr(c01, cl.Value) = False Then c01 = c01 & "|" & cl.Value
    Next
    Sheets("Samenvatting").Cells(1, i).Resize(UBound(Split(c01, "|"))) = Application.Transpose(Split(Mid(c01, 2), "|"))
    c01 = ""
Next
End With
End Sub

 

[Niels28]

@Warme bakkertje

Dank je, heb ik meteen geleerd hoe je range & cells moet combineren.

Niels

 

[ZZ1]

Harstikke bedankt Warme Bakkertje, dit werkt echt super!

 

[Warme bakkertje]

Alle eer gaat naar Niels28, ik heb maar een kleine aanpassing gedaan.

 

[Niels28]

Zet je de vraag dan op opgelost.

@Warmbakkertje , een deel van die eer gaat toch echt naar jouw als
je wist hoeveel ik heb geleerd van jouw antwoorden.

Niels