Dubbele namen tellen

adile · 16 okt 2015

goedemiddag,

Ik heb een excel bestandje waarin op 3 pagina's namen staan.
Deze namen staan in de cellen A3 t/m A10.

Nu heb ik een vierde pagina waar ik namen die dubbel voorkomen, automatisch naar toe wil plaatsen.
Tevens wil ik dat er in de cel achter de naam die dubbel voorkomt, ook het aantal keren dat hij voorkomt automatisch vermelden.
tot slot moet deze namenlijst ook automatisch gesorteerd worden, met de meest voorkomende naam bovenaan.

Nu is mijn vraag, hoe kan ik dit realiseren en wie kan mij hierbij helpen?

bestandje heb ik bijgevoegd.

alvast bedankt.

Adile

Timshel · 16 okt 2015

Code:

Sub tsh()
    Dim Br
    Dim Jip
    Dim Nm As String
    Dim i As Long, j As Long
    
    With CreateObject("Scripting.Dictionary")
        For i = 1 To Sheets.Count - 1
            Br = Sheets(i).Cells(3, 1).CurrentRegion
            For j = 1 To UBound(Br)
                If InStr(Nm, Br(j, 1) & "|") > 0 Then
                    Jip = .Item(Br(j, 1))
                    If IsEmpty(Jip) Then Jip = Array("", 1)
                    .Item(Br(j, 1)) = Array(Br(j, 1), Jip(1) + 1)
                Else
                    Nm = Nm & Br(j, 1) & "|"
                End If
            Next
        Next
        Br = Application.Index(.items, 0)
    End With
    With Sheets(Sheets.Count)
        .Cells(2, 1).Resize(UBound(Br), 2) = Br
        .Cells(1, 1).CurrentRegion.Sort .[B1], Header:=xlYes
    End With
End Sub

adile · 16 okt 2015

dag Timshel

bedankt voor de formule die je gestuurd hebt, maar zou je er een uitleg bij kunnen geven hoe ik deze moet toepassen en wat ik moet aanpassen om hem werkend te maken? Ik ben namelijk een beetje een leek wat VBA betreft.

Gr Adile

Timshel · 16 okt 2015

Druk op ALT-F11 om de VB-editor te openen.
Onder menuitem 'Invoegen' kies je voor 'Module'.
Kopieer en plak de VBA-routine in de module en sluit de VB-editor af.
Vanuit Excel druk je op ALT-F8 en dubbelklik op 'tsh'.

adile · 16 okt 2015

Timshel,

Yes! dit is bijna wat ik wil hebben.De meest voorkomende naam komt nu onderaan, maar deze moet dus bovenaan komen.

en 2.

Deze VBA code moet ik toepassen op een bestand (te groot om hier te posten) met 53 tabbladen week 1 t/m week 53 waar de namen in staan van rij 5 t/m rij 41.
het blad waar de namen in komen te staan heet Eindlijst.

zou je rood kunnen maken wat ik zou moeten aanpassen?

nogmaals heel veel dank.

Adile

Timshel · 16 okt 2015

Code:

Sub tsh()
    Dim Br
    Dim Jip
    Dim Nm As String
    Dim i As Long, j As Long
    
    With CreateObject("Scripting.Dictionary")
        For i = 1 To Sheets.Count - 1
            [COLOR="#FF0000"]Br = Sheets(i).Range("A5:A41")[/COLOR]
            For j = 1 To UBound(Br)
                If InStr(Nm, Br(j, 1) & "|") > 0 Then
                    Jip = .Item(Br(j, 1))
                    If IsEmpty(Jip) Then Jip = Array("", 1)
                    .Item(Br(j, 1)) = Array(Br(j, 1), Jip(1) + 1)
                Else
                    Nm = Nm & Br(j, 1) & "|"
                End If
            Next
        Next
        Br = Application.Index(.items, 0)
    End With
    [COLOR="#FF0000"]With Sheets("Eindlijst")[/COLOR]
        .Cells(2, 1).Resize(UBound(Br), 2) = Br
        .Cells(1, 1).CurrentRegion.Sort .[B1][COLOR="#FF0000"], Order1:=xlDescending[/COLOR], Header:=xlYes
    End With
End Sub

sylvester-ponte · 16 okt 2015

misschien nog vba regeltje om eerst de oude waarden te verwijderen:
na With Sheets("Eindlijst")
.Cells(1, 1).CurrentRegion.Offset(1).ClearContents

soms zijn er ineens minder namen dan is het handig als de overige namen verdwijnen

WHER · 16 okt 2015

Een variant, toegepast in het bestand uit post 1.
De aanpassingen in het rood zijn hier nog niet doorgevoerd.

edit: en de opmerking van Sylvester ook niet

HSV · 16 okt 2015

Nog een variant.

Code:

Sub hsv()
Dim oDic As Object, sn, i As Long, ii As Long
Set oDic = CreateObject("scripting.dictionary")
For i = 1 To Sheets.Count - 1
sn = Sheets(i).Range("a3:a17").specialcells(2)
  For ii = 1 To UBound(sn)
       oDic.Item(sn(ii, 1)) = oDic.Item(sn(ii, 1)) + 1
  Next ii
 Next i
 With Blad4
   .Cells(2, 1).Resize(oDic.Count, 2) = Application.Transpose(Array(oDic.keys, oDic.items))
   .Cells(1).CurrentRegion.Sort [COLOR="#FF0000"].[/COLOR][a1], , , , , , , 1
 End With
End Sub

adile · 16 okt 2015

Allemaal hartelijk dank voor alle input,

Ik heb de code van Timshel gebruikt met de toevoeging van sylverster op deze manier.

Code:

Sub tsh()
    Dim Br
    Dim Jip
    Dim Nm As String
    Dim i As Long, j As Long
    
    With CreateObject("Scripting.Dictionary")
        For i = 1 To Sheets.Count - 1
            Br = Sheets(i).Range("G5:G41")
            For j = 1 To UBound(Br)
                If InStr(Nm, Br(j, 1) & "|") > 0 Then
                    Jip = .Item(Br(j, 1))
                    If IsEmpty(Jip) Then Jip = Array("", 1)
                    .Item(Br(j, 1)) = Array(Br(j, 1), Jip(1) + 1)
                Else
                    Nm = Nm & Br(j, 1) & "|"
                End If
            Next
        Next
        Br = Application.Index(.items, 0)
    End With
    With Sheets("Eindlijst")
        .Cells(2, 2).CurrentRegion.Offset(1).ClearContents
        .Cells(3, 2).Resize(UBound(Br), 2) = Br
        .Cells(2, 2).CurrentRegion.Sort .[C1], Order1:=xlDescending, Header:=xlYes
    End With
End Sub

Hij werkt perfect, hij telt alles op en ook nog eens op volgorde.

hartelijk dank daarvoor.

alleen 1 ding; als ik de macro gebruik, geeft hij in cel 4 van de eindlijst wanneer ik geen namen heb ingevuld het getal 2035.
bij iedere dubbele waarde neemt dit getal met 1 af.

kan dit dit getal ook weg of moet ik gewoon die rij verbergen? wat opzich ook geen probleem is.

in ieder geval heel veel dank voor alle hulp.

gr adile

sylvester-ponte · 16 okt 2015

WHER, voeg in blad1 eens 3 maal alje toe en probeer het dan nog eens

sylvester-ponte · 16 okt 2015

ik ook eentje:

Code:

Sub Sylvester()
    With CreateObject("Scripting.Dictionary")
        For Each Sh In Sheets
            If Sh.Name <> "Eindlijst" Then
                For Each R In Sh.Cells(3, 1).CurrentRegion
                    .Item(R.Value) = .Item(R.Value) + 1
                Next
            End If
        Next
        Sheets("Eindlijst").Select
        Cells.ClearContents
        [A1] = "namen": [B1] = "aantal"
        t = 2
        For Each K In .keys
            If .Item(K) > 1 Then
                t = t + 1
                Cells(t, 1) = K
                Cells(t, 2) = .Item(K)
            End If
        Next
    End With
    If Not IsEmpty([A3]) Then [A3].CurrentRegion.Sort [B3], xlDescending, [A3]
End Sub

WHER · 16 okt 2015

@Sylvester,

Je hebt gelijk, denkfoutje van mij.
Mijn resultaat was per toeval hetzelfde als het correcte resultaat.

Timshel · 16 okt 2015

adile zei:
alleen 1 ding; als ik de macro gebruik, geeft hij in cel 4 van de eindlijst wanneer ik geen namen heb ingevuld het getal 2035.
bij iedere dubbele waarde neemt dit getal met 1 af.

kan dit dit getal ook weg of moet ik gewoon die rij verbergen? wat op zich ook geen probleem is.

Volgens mij zo:

Code:

Sub tsh()
    Dim Br
    Dim Jip
    Dim Nm As String
    Dim i As Long, j As Long
    
    With CreateObject("Scripting.Dictionary")
        For i = 1 To Sheets.Count - 1
            Br = Sheets(i).Range("A5:A41")
            For j = 1 To UBound(Br)
                If InStr(Nm, Br(j, 1) & "|") > 0 Then
                    Jip = .Item(Br(j, 1))
                    If IsEmpty(Jip) Then Jip = Array("", 1)
                    .Item(Br(j, 1)) = Array(Br(j, 1), Jip(1) + 1)
                Else
                    Nm = Nm & Br(j, 1) & "|"
                End If
            Next
        Next
        [COLOR="#FF0000"]If .Exists(vbNullString) Then .Remove vbNullString[/COLOR]
        Br = Application.Index(.Items, 0)
    End With
    With Sheets("Eindlijst")
        .Cells(1, 1).CurrentRegion.Offset(1).ClearContents
        .Cells(2, 1).Resize(UBound(Br), 2) = Br
        .Cells(1, 1).CurrentRegion.Sort .[B1], Order1:=xlDescending, Header:=xlYes
    End With
End Sub

adile · 17 okt 2015

Goedenavond allen,

Sorry voor de late reactive, maar had geen pc tot mijn beschikking.

ik heb hem getest Timshel, en het probleem met dat cijfer is opgelost.
als er dubbele namen zijn ingevuld in de sheets werkt jouw code perfect.

alleen ik heb een probleempje wanneer er geen dubbele warden zijn, dan geeft hij een error.

Code:

Sub tsh()
    Dim Br
    Dim Jip
    Dim Nm As String
    Dim i As Long, j As Long
    
    With CreateObject("Scripting.Dictionary")
        For i = 1 To Sheets.Count - 1
            Br = Sheets(i).Range("A5:A41")
            For j = 1 To UBound(Br)
                If InStr(Nm, Br(j, 1) & "|") > 0 Then
                    Jip = .Item(Br(j, 1))
                    If IsEmpty(Jip) Then Jip = Array("", 1)
                    .Item(Br(j, 1)) = Array(Br(j, 1), Jip(1) + 1)
                Else
                    Nm = Nm & Br(j, 1) & "|"
                End If
            Next
        Next
        If .Exists(vbNullString) Then .Remove vbNullString
        [COLOR="#FF0000"]Br = Application.Index(.Items, 0)[/COLOR]
    End With
    With Sheets("Eindlijst")
        .Cells(1, 1).CurrentRegion.Offset(1).ClearContents
        .Cells(2, 1).Resize(UBound(Br), 2) = Br
        .Cells(1, 1).CurrentRegion.Sort .[B1], Order1:=xlDescending, Header:=xlYes
    End With
End Sub

de roodgekleurde zin kleurt dan geel, hij geeft aan dat daar het probleem zit.

@ Wher, HSV en Sylvester,

Ik heb al jullie codes geprobeerd, maar die kreeg ik niet werkend in mijn bestand dat ik daadwerkelijk gebruik.

Ik heb alleen nog dat error probleem in de code van Timshel, als dat is verholpen kan ik hem op opgelost zetten.

Gr Adil

HSV · 17 okt 2015

In jouw voorbeeldbestand werkt mijn code feilloos.

Voor de rest kan ik alleen maar een tip geven:
Maak een gelijkend voorbeeldbestand van je daadwerkelijk bestand.

sylvester-ponte · 17 okt 2015

Adil, ik ben wel heel benieuwd waar het fout gaat in mijn subje (sub Sylvester() )

adile · 17 okt 2015

@ HSV,

De Jouwe telde wel op, maar hij nam ook veel andere zaken mee die niet in de betreffende kolom stonden.
dus ik had op mijn eindlijst een hele lange waslijst staan, terwijl ik maar drie dubbele namen had.

en bij jou Sylvester kreeg ik een error en wilde hij niet tellen, dat was ook het geval bij de code van Wher.

Adile

adile · 17 okt 2015

Oh ps; HSV ik zal aan je tip denken in de toekomst, alleen was mijn originele bestand zo groot dus ik dacht ik maak iets dat lijkt op wat ik wil.

HSV · 17 okt 2015

Waar in dit bestand worden er andere zaken weergegeven?

Edit: Je wil alleen maar de dubbele namen zien?

Dubbele namen tellen

Gebruiker

Bijlagen

Terugkerende gebruiker

Gebruiker

Terugkerende gebruiker

Gebruiker

Terugkerende gebruiker

Verenigingslid

Terugkerende gebruiker

Bijlagen

Inventaris

Gebruiker

Verenigingslid

Verenigingslid

Terugkerende gebruiker

Bijlagen

Terugkerende gebruiker

Gebruiker

Inventaris

Verenigingslid

Gebruiker

Gebruiker

Inventaris

Bijlagen

Wij waarderen jouw privacy