Namen, tussenvoegsels en initialen splitsen

[ChristianEvers]

Hallo,

Ik heb een kolom met namen, initialen en af en toe ook tussenvoegsel (zie voorbeeld)

Ik wil nu graag alle achternamen, inclusief eventuele meisjesnamen, in 1 cel. Dan de tussenvoegsels in 1 cel, en dan de initialen in 1 cel.

Splitsen naar kolommen heb ik volgens mij niet veel aan want dan worden ook dubbele achternamen (zoals Vennegoor of Hesselink) uit elkaar getrokken.

Hopelijk kan iemand me helpen...

 

[Wigi]

Hallo,

Ik heb een kolom met namen, initialen en af en toe ook tussenvoegsel (zie voorbeeld)

Ik wil nu graag alle achternamen, inclusief eventuele meisjesnamen, in 1 cel. Dan de tussenvoegsels in 1 cel, en dan de initialen in 1 cel.

Splitsen naar kolommen heb ik volgens mij niet veel aan want dan worden ook dubbele achternamen (zoals Vennegoor of Hesselink) uit elkaar getrokken.

Hopelijk kan iemand me helpen...

Je vreest het al, dit gaat zomaar niet. Cellen uiteen halen, OK, maar hoe ga je Excel duidelijk maken waar een deel stopt en een ander deel begint?

Je moet eerst al beginnen met de excessieve spaties op het einde weg te doen. Laat deze macro uitvoeren:

Sub spatiesweg()
Dim c As Range
For Each c In Range("A1").CurrentRegion
    c = Trim(c)
Next
End Sub

Wigi

 

[ChristianEvers]

Gedaan, dat werkte goed.

Zit zelf te denken dat Excel de initialen kan herkennen omdat dat de enige tekens zijn die 'alleen' staan. Misschien mogelijk om letterreeksen die groter dan 1 karakter zijn te filteren? Ik zeg maar wat...

 

[Withaar]

Is dit wat van de HCC site; http://home.hccnet.nl/p.snip/resource/Excel/vb2.html

 

[Wigi]

Is dit wat van de HCC site; http://home.hccnet.nl/p.snip/resource/Excel/vb2.html

Ik denk dat dat idd is wat gevraagd wordt. Ik heb de VBA code bekeken en daar kan nog wel een en ander verbeterd worden (het werkt wel!). Als ik tijd heb, doe ik dat (of iemand anders mag dat ook altijd doen natuurlijk)

Wigi

 

[Withaar]

Let wel op met dubbel achternamen e.d.
'J van der Sluit op het Hof' bv zal niet goed gaan.
Misschien moet je alle achternamen met meer dan 3 spaties er in even uitsorteren en met de hand doen.

 

[brunniepoo]

in principe zou je beginletters moeten kunnen herkennen aan een punt, terwijl tussenvoegsels een eindige categorie is. De rest is achternaam. Moet met wat zoeken en splitsen wel mogelijk zijn, lijkt me.

 

[Withaar]

in principe zou je beginletters moeten kunnen herkennen aan een punt, terwijl tussenvoegsels een eindige categorie is. De rest is achternaam. Moet met wat zoeken en splitsen wel mogelijk zijn, lijkt me.

Uit het voorbeeld bestand blijkt dat er geen punten gebruikt worden..
Dit is echt een lastig probleem hoor (in algemene zin). Als je gaat zoeken op internet merk je dat veel mensen zich er mee bezig hebben gehouden en een 100% oplossing heb ik nog niet gezien.

 

[Wigi]

Als je gaat zoeken op internet merk je dat veel mensen zich er mee bezig hebben gehouden en een 100% oplossing heb ik nog niet gezien.

Heel simpel... een oplossing die 100% werkt bestaat niet voor dit probleem.

 

[Wigi]

een oplossing die 100% werkt bestaat niet voor dit probleem.

Aangezien het toch niet kan, ga ik er nu geen tijd aan verliezen, behalve dan dat ik de code opgekuist heb (uit de link die Withaar gaf). Hier is het:

Sub NaamSplitsen()
Dim X As Integer, Y As Integer, RijTeller As Long, Spatie(10) As Integer, c As Range
Dim Voorvoegsel As String, Achternaam As String, Naam As String, Voornaam As String

Voorvoeg = MsgBox("Wilt u de voorvoegsels in een aparte kolom?", vbYesNo)
    If Voorvoeg = vbNo Then
        StopZoek = MsgBox("Wilt u de voorvoegsels (van der, v/d) naar de kolom van de achternamen meekopiëren?", vbYesNo)
    End If

For Each c In Range("A1", Range("A1").Range("A" & Rows.Count).End(xlUp))
    
    Naam = Replace(Trim(c.Value), "  ", " ")
    Y = 0
    Spatie(1) = 0
    For X = 1 To Len(Naam) ' Zoeken naar eerste spatie
        If Mid(Naam, X, 1) = " " Then
            Y = Y + 1
            Spatie(Y) = X
            If StopZoek = vbYes Then Exit For ' Voorvoegsels bij Achternaam.
        End If
    Next
    
    If Spatie(1) <> 0 Then ' Spatie gevonden
        If Voorvoeg = vbNo Then
            If StopZoek = vbYes Then Y = 1
            Voornaam = Mid(Naam, 1, Spatie(Y) - 1)
            c = Voornaam
            Achternaam = Mid(Naam, Spatie(Y) + 1)
            c.Offset(, 1) = Achternaam
        Else ' Voorvoegsels apart naar kolom C
            Voornaam = Mid(Naam, 1, Spatie(1) - 1)
            c = Voornaam
            Achternaam = Mid(Naam, Spatie(Y) + 1)
            c.Offset(, 1) = Achternaam
            If Y > 1 Then
                Voorvoegsel = Mid(Naam, Spatie(1), Spatie(Y) - Spatie(1) + 1)
                c.Offset(, 2) = Trim(Voorvoegsel)
            End If
        End If
    Else ' Naam naar kolom B
        c = Naam
    End If
Next
End Sub

Wigi

 

[ChristianEvers]

Bedankt voor alle moeite!

Die laatste macro geeft voor de meeste gevallen een goede splitsing in (eerste) achternaam en initialen.

Ik heb dan dus twee kolommen, 1 waarin (eerste deel van) de achternaam staat en een 2e kolom waarin initialen staan (dit zijn de namen die reeds helemaal goed zijn gesplitst) of waarin initialen staan met ook nog stukken van dubbele achternamen en tussenvoegsels.

De tussenvoegsels staan altijd achter de initialen, de restanten van dubbele achternamen altijd ervoor.

Ik kan alle namen die reeds goed zijn gesplitst herkennen doordat de 2e kolom alleen maar hoofdletters bevat (van de initialen) en die vast wegschrijven naar een ander werkblad. [via =GELIJK(HOOFDLETTERS(A1);A1) ]

De overgeblevenen zijn dan dus de probleemgevallen. Is het misschien mogelijk om met een lijst van alle mogelijke tussenvoegsels de tussenvoegsels er uit te filteren? Dan zijn we weer een stap verder... via wikipedia heb ik een lijst met tussenvoegsels gevonden. (zie bijgevoegd bestand, blad 3)