• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Excel lijst ontdubbelen en som maken

Status
Niet open voor verdere reacties.

coture

Nieuwe gebruiker
Lid geworden
15 feb 2018
Berichten
2
Hallo allemaal,

ik heb een lijst postcodes die ik zou willen ontdubbelen en naast elke (unieke) postcode zou dan moeten staan hoeveel keer die postcode voorkwam in de lijst...
Ik heb al verschillende formules geprobeerd, maar blijf sukkelen... Wie kan mij helpen aub?

Bedankt!

In bijlage mijn lijst...Bekijk bijlage Werkmap1.xlsx
 
Zoek je zoiets als in bijlage?

1. Heb lijst gekopieerd, en daarna via knop "duplicaten verwijderen" een unieke lijst verkregen.
2. Middels functie AANTAL.ALS kun je dan het aantal keren dat de postcode voorkomt tellen.
 

Bijlagen

  • Werkmap1 (AC).xlsx
    40,3 KB · Weergaven: 19
In dit geval heb ik een macro opgenomen en vervolgens een klein beetje aangepast.
Het vinden van de laatste gevulde rij heb ik toegevoegd.
Code:
Sub HoevaakEnOntdubbel()
'
' HoevaakEnOntdubbel Macro
'
    Dim rijNummer As Long
'
    rijNummer = Range("A1").End(xlDown).Row
    Range("B2").Select
    Selection.FormulaR1C1 = "=COUNTIF(R2C1:R2880C1,RC[-1])"
    Selection.AutoFill Destination:=Range("B2:B" & rijNummer)
    Range("B2:B" & rijNummer).Select
    Selection.Copy
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    ActiveSheet.Range("$A$1:$B$" & rijNummer).RemoveDuplicates Columns:=1, Header:= _
        xlYes
End Sub

Succes,
 
Kan toch zeer eenvoudig met een draaitabel.

@WoutMag, Als zelfbenoemd Excel 2016 Expert kan je de code toch wel iets eenvoudiger maken?
Zoiets zal wel ongeveer hetzelfde doen.
Code:
Sub VenA()
ar = Sheets("Blad1").Cells(1).CurrentRegion
  With CreateObject("Scripting.Dictionary")
  For j = 2 To UBound(ar)
    .Item(ar(j, 1)) = .Item(ar(j, 1)) + 1
  Next j
  Sheets("Blad1").Cells(1, 10).Resize(.Count, 2) = Application.Transpose(Array(.keys, .items))
  End With
End Sub
 

Bijlagen

  • Werkmap1.xlsb
    47,1 KB · Weergaven: 26
Laatst bewerkt:
Ik moet bekennen dat ik de Scripting.Dictionary nog niet kende.
 
Wauw,top! Dit is precies wat ik nodig had, ik ga dit zorgvuldig bewaren, zal zeker nog van pas komen! Dankjewel voor de snelle hulp!
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan