Auteur Topic: gelijke nummers uit een lijst halen (gelezen 6808 keer)

ceasar · « **Gepost op:** 03 februari 2008, 10:34:58 »

Beste oplossers,

ik doe een poging om uit een bestand enkele honderde dubbele nummers te halen.

ik heb al een poging gedaan, maar het lukt me niet volledig. graag zou ik dat met vba doen

kan er iemand mij helpen?

groeten

JC

danny147 · « **Reactie #1 Gepost op:** 03 februari 2008, 13:23:00 »

Beste ceasar

Als je de volgende formule in cel C23 plaatst dan krijg je het dubbel in die cel.

Code: [Selecteer]

=ALS(AANTAL.ALS(D5:D88;D23);D23;"")
Denk niet dat je hier om vraagt maar het is al een stukje dat je uit je VBA code kan verwijderen.

Groetjes Danny.

RedHead · « **Reactie #2 Gepost op:** 03 februari 2008, 14:05:16 »

Ceasar, En waarom doe je dat niet met het Advanced Filter (Uitgebreid filter)? Je kan daarmee namelijk kiezen voor de optie Unique Records Only (alleen unieke records). Het is zelfs mogelijk om het 'gefilterde' naar een andere plek op de sheet te zetten.

Groet, Leo

P.s. als voorbeeldje een screenshot van het advanced filter (bereiken zijn ander voor jou!)

firmin · « **Reactie #3 Gepost op:** 03 februari 2008, 17:27:48 »

Ik gebruik onderstaande code, via een button op het blad.

Sub filternamen()
Sheet1.Columns("A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Columns("I"), Unique:=True
End sub

Private Sub CommandButton1_Click()
filternamen
End Sub

De 1ste sub end zet je in een procedure
De 2de zet je onder de button.
De verwijzigingen kolom A en kolom I dienen aangepast te worden aan uw blad.
Kolom I geeft het resultaat van de volledige sheet zonder dubbels.
Bij meerdere kolommen dien je A te vervangen door bv A:C en I door I:K

Om het gefilterde terug op zijn plaats te zetten, eerst kolom A (of A: ) clearcontents
daarna kolom i (of I: ) cut
kolom A paste

Firmin

ceasar · « **Reactie #4 Gepost op:** 04 februari 2008, 08:16:20 »

beste oplossers,

de voorgebrachte oplossingen zijn zeker valabel.

maar de bedoeling is om in de kolom naast de formule de dubbele nummers te krijgen.

m.a.w. als je boven de uitgezuiverde kolommen staat, dus als de formule tot beneden 0 is, dan zijn de dubbele nummers in de kolom ernaast.
Met een eenvoudige filter erboven krijg je de uitgezuiverde nummers, die dan gebruikt worden om op een ander blad, deze nummers van tussen een 4.000 dossiers uit te halen. Dan bevat dat andere blad alleen unieke nummers.

dit komt er nog niet volledig uit.

als ik het resultaat van de uitgebreide filter kan krijgen
en de dubbele nummers staan apart, dan bereik ik het doel.

bedankt al voor de geleverde inspanningen

JC

RedHead · « **Reactie #5 Gepost op:** 04 februari 2008, 13:36:43 »

Ceasar, Het is me nav je antwoord niet duidelijk of je probleem nu opgelost is...

Groet, Leo

ceasar · « **Reactie #6 Gepost op:** 04 februari 2008, 14:50:40 »

Leo,

niet dus.

hetgeen de uitgebreide filter doet, is het resultaat van
de bewerking.

ik kan dit procede niet toepassen op het andere blad,
ik heb dan een te groot risico om gegevens te verliezen.

vandaar deze omweg.

groeten

JC

RedHead · « **Reactie #7 Gepost op:** 05 februari 2008, 22:43:39 »

Ceasar, Ik heb een blokje code voor je geschreven die alle dubbele getallen in de range opzoekt en er vervolgens een apart lijstje van maakt.

Code: [Selecteer]

Sub VindDubbelen()
'Leo Meijer; Oplossing.BE; 05/02/2008
Dim MyArr() As Variant
Dim x As Long, i As Long
Dim r As Range
Dim bDubbel As Boolean
Const cKolom As Integer = 3 'geef hier aan in welke kolom de dubbelen worden weggeschreven
    
    'zet in kolom B eerst alle unieke waarden
    Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Columns( _
        "B:B"), Unique:=True
    Range("B1").Value = "Unieke waarde"
    Columns("B:B").EntireColumn.AutoFit
    
    'en ga dan over naar het zoeken van de dubbele...
    bDubbel = False

    x = 0 'teller van de array
    
    For Each r In Selection
        ReDim Preserve MyArr(x)
        'controleer of de waarde in de cel meerdere keren voor komt in de selectie
        If WorksheetFunction.CountIf(Selection, r.Value) > 1 Then
            'als dit zo is, controleer of de waarde al is opgeslagen in de array
            For i = LBound(MyArr) To UBound(MyArr)
                If r.Value = MyArr(i) Then bDubbel = True
                If bDubbel Then Exit For 'zoek niet verder...
            Next i
            'als de waarde nog niet bestaat in de array wordt deze toegevoegd
            If bDubbel = False Then MyArr(x) = r.Value
            bDubbel = False
            x = x + 1
        End If
    Next r
    
    Cells(1, cKolom).Value = "Dubbele waarde"
    
    'plaats het overzicht van 'dubbelen' op de sheet
    For i = LBound(MyArr) To UBound(MyArr)
        Cells(i + 2, cKolom).Value = MyArr(i)
    Next i
        
    Columns(cKolom).EntireColumn.AutoFit
        
    MsgBox "klaar"

End Sub

Hoe werkt dit? Zet je overzicht van getallen in kolom A. Geef in de code bij de constante cKolom aan in welke kolom je de 'dubbelen' wilt wegschrijven (default is kolom C). Selecteer vervolgens alle getallen in kolom A en 'run' de code. Er verschijnt dan een lijst(je) met alle gevonden 'dubbele' getallen in kolom C en een lijst(je) met unieke getallen in kolom B.

Of zit ik er nu wéér naast...

Groet, Leo

EDIT: code aangepast met het tonen van de unieke waarden in kolom B

RedHead · « **Reactie #8 Gepost op:** 06 februari 2008, 22:49:22 »

Hierbij - voor de geïnteresseerden - de code uitgewerkt in een bestandje (vergeet dus de code hierboven

). Er zijn nog wat foutafhandelingen toegevoegd. En een extra teller om te zien hoeveel dubbelen er totaal in de tabel zaten.

Groet, Leo

ceasar · « **Reactie #9 Gepost op:** 08 februari 2008, 10:51:54 »

,

Beste Leo,

wat een bescheidenheid, maar het lukt dus volledig!!!

ik heb de nummers uit een lijst van een vijfduizend records gehaald, en er waren er zelfs die er drie keer in voorkwamen, en soms vier keer.

conclusie:

je zit er volledig ON top OP.

bedankt voor je oplossing, want dit bespaart mij zo maar effentjes een paar uur.

daar zegt men "dikke klasse" tegen.

groeten

JC

RedHead · « **Reactie #10 Gepost op:** 08 februari 2008, 21:37:20 »

Ceasar, dank voor deze mooie woorden...

ff voor mijn nieuwsgierigheid....

Citaat

ik heb de nummers uit een lijst van een vijfduizend records gehaald

'performde' dat nog een beetje??

Groet, Leo

ceasar · « **Reactie #11 Gepost op:** 09 februari 2008, 08:56:02 »

Leo,

om je een idee te geven voor de tijdwinst die je met je programmatje boekt:

-je copieert van de sheet de bewuste uit te zuiveren kolom

-daarnaast plaats je de kolom die je bereikt met de uitgebreide filter.

- je vult de formule in van de ene cel min de andere cel

-je scrollt tot aan het eerste verschil, je knipt en plakt
de dubbele uit je te zuiveren kolom.

-de knipt en plakt de kolom terug op de cel om dan terug de formule naar beneden te sturen in de te zuiveren kolom en je doet dit totdat alle uitkomsten
van de formule 0 geven.
- je filtert dan de uitgezuiverde kolom en daar is dan je resultaat.

met je programma: op de kop 10 seconden, bovenstaand: 3 a 4 uren werk.

enig idee nu ?

met dank

JC

Help!

Menu

Hulp bij posten

Zoeken

Recente topics

Auteur Topic: gelijke nummers uit een lijst halen (gelezen 6808 keer)

ceasar

gelijke nummers uit een lijst halen

danny147

Re: gelijke nummers uit een lijst halen

RedHead

Re: gelijke nummers uit een lijst halen

firmin

Re: gelijke nummers uit een lijst halen

ceasar

Re: gelijke nummers uit een lijst halen

RedHead

Re: gelijke nummers uit een lijst halen

ceasar

Re: gelijke nummers uit een lijst halen

RedHead

Re: gelijke nummers uit een lijst halen

RedHead

Re: gelijke nummers uit een lijst halen

ceasar

Re: gelijke nummers uit een lijst halen

RedHead

Re: gelijke nummers uit een lijst halen

ceasar

Re: gelijke nummers uit een lijst halen