unieke waarden weergeven
vincent
Ik heb een lange lijst met afkortingen in kolom A in werkblad
"gegevens". Er worden maximaal 5 afkortingen gebuikt, maar deze komen
meerdere keren terug.
Nu wil ik in het werkblad "opsomming" in de cellen A1, A2, A3, A4 en
A5 de
afkortingen weergeven die in werkblad "gegevens" in kolom A worden
genoemd. Het kan zijn dat er 1, 2, 3, 4 of 5 afkortingen in de lijst
voorkomen.
Even visualiseren:
Kolom A
ABC
KLM
KLM
FDD
FDD
ABC
KLM
In werkblad "opsomming" moet nu dus komen te staan:
Kolom A
ABC
KLM
FDD
-
-
Kan dit zonder macro?
Alvast bedankt!
Vincent
René
zul je wel wat hulpvelden moeten gebruiken in tabblad "Opsomming":
Begin in kolom C:
- Nummer in C1 t/m C1000 van 1 tot 1000 (dus C1--> 1, C2 --> 2 etc.)
Vervolgens Kolom E:
- Deze laat je verwijzen naar je lijst afkortingen in tabblad
"Gegevens". Dus E1--> =gegevens!A1, E2--> =gegevens!A2
Vervolgens Kolom D:
-In D1 zet je het getal 1; in D2 de formule: =ALS(AANTAL.ALS($E
$1:E1;E2)=0;1+C2/100000;0) en deze copieer je naar beneden tot aan cel
D1000.
Vervolgens Kolom B:
-In B1 zet je de formule: =ALS(AANTAL.ALS($D$1:$D
$7;0)<C1+1;0;KLEINSTE($D$1:$D$7;AANTAL.ALS($D$1:$D$7;0)+C1)) en deze
copieer je naar beneden tot aan cel B1000.
En dan de formule die het uiteindelijke reslutaat geeft in Kolom A:
-In A1 zet je de formule: =ALS(B1=0;"";VERT.ZOEKEN(B1;$D$1:$E
$7;2;ONWAAR)) en deze coieer je naar beneden tot aan cel A1000.
LET OP; de vreemde volgorde van kolommen is bewust gekozen; oa omdat
anders verticaal zoeken niet werkt.
Gr., Rene
vincent
Rene,
Met jouw oplossing krijg ik niet het gewenste resultaat. Maar dat kan
ook liggen aan het feit dat ik niet goed begrijp hoe de formules in
elkaar steken.
In mijn opzet zou er op werkblad "opsomming" alleen in cellen A1, A2,
A3, A4 en A5 een waarde komen te staan. Namelijk de afkortingen die
voorkomen in de lijst op werkblad "gegevens". Met jouw oplossing komen
er waardes voor in cellen a1:a1000?
Als het eenvoudig kan met VBA, dan is dat wellicht een oplossing. Punt
is alleen dat ik ook weer vele werkbladen heb...
Vincent
popipipo
Daar heb je toch het advanced filter voor om unieke waarden uit een
reeks weer te geven.
Gr Willem
René
Voor de A-kolom hoef je de formules inderdaad niet helemaal door te
trekken tot A1000. Voor jouw probleem volstaat om te copieren tot aan
A5.
Maar mochten er méér dan 5 afkortingen voorkomen, dan wordt daar
meteen in voorzien.
Bij mij werkt alles prima, maar mocht je behoefte hebben aan een
simpel VBA-scriptje, dan laat maar even weten.....
Gr., René
vincent
René,
Het werkt inderdaad! Slim bedacht. Hoe je het bedacht krijgt is mij
een wonder.
De extra kolommen zijn toch niet echt handig, ook al kun je ze
verbergen natuurlijk.
Kun je de VBA oplossing ook nog tevoorschijn toveren als het niet te
veel moeite is?
Alvast bedankt.
Groet,
Vincent
Peter Sellmeijer
"vincent" schreef in bericht
news:2d569d46-b8b0-4851...@s11g2000yqc.googlegroups.com...
Beste iedereen,
Even visualiseren:
Kan dit zonder macro?
Alvast bedankt!
Vincent
In de Office 2010 is in de ribbon "Gegevens" het item "Duplicaten
verwijderen"
Dan hoef je alleen maar de lijst te kopiëren naar tabblad opsomming en uit
te voeren
Gr. Peter
René
Onderstaande macro maakt je lijstje met unieke afkortingen.
Daarbij ben ik uitgegaan en een tabblad "gegevens", waarbij de
afkortingen in de A-kolom staan,
en een tabblad "opsomming", waar de lijst met unieke afkortingen in
kolom 9 (=I-kolom) wordt neergezet.
Veel plezier ermee!
Gr., René
Sub LijstUniekeAfkortingen()
Dim TellerGegevens, TellerOpsomming, LaatsteRij, _
VolgendeRij, KolomLijst As Integer, Uniek As Boolean
'Kolom definiëren waar de lijst moet komen te staan.
KolomLijst = 9
'Eerst oude unieke waardelijst leegmaken.
Worksheets("opsomming").Columns(KolomLijst).ClearContents
'Laatst gevulde rijnummer bepalen van tabblad "gegevens" (LaatsteRij).
With Worksheets("gegevens")
LaatsteRij = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
'De eerste afkorting in rij 1 zetten:
Worksheets("opsomming").Cells(1, KolomLijst).Value = _
Worksheets("gegevens").Cells(1, 1).Value
'Rest van de lijst laten beginnen in rij 2.
VolgendeRij = 2
'De rest van de lijst:
For TellerGegevens = 2 To LaatsteRij
For TellerOpsomming = 1 To (VolgendeRij - 1)
Uniek = True 'Afkorting is uniek tot het tegendeel bewezen
is.
If Worksheets("gegevens").Cells(TellerGegevens, 1).Value = _
Worksheets("opsomming").Cells(TellerOpsomming,
KolomLijst).Value Then
Uniek = False
Exit For
End If
Next TellerOpsomming
If Uniek = True Then
Worksheets("opsomming").Cells(VolgendeRij, KolomLijst).Value =
_
Worksheets("gegevens").Cells(TellerGegevens, 1).Value
VolgendeRij = VolgendeRij + 1
End If
Next TellerGegevens
End Sub