Namen, tussenvoegsels, initialen en titels splitsen

[Erik Smit]

Beste Leo,

Hierbij het antwoord op je vragen.

1. De basis van het bestand wisselt heel erg, we krijgen de bestanden aangeleverd van klanten en het is wel eens nodig om dat uit elkaar te halen. Vandaar.
2. Ja, we moeten vrij regelmatig zo'n lijst splitsen en het aantal records wisselt dus enorm. Vandaar dat ik er ook al 2 dagen mee bezig ben.

Maar nu blijft mijn vraag, hoe splits ik dit het makkelijkst met VB.
Ik heb hem nu al zover dat ie vragen stelt en dat hij de aanhef er uit filtert. Maar nu de rest nog.

Voor de titels heb ik het idee om VB te laten zoeken naar kleine letters tot hij een punt gevolgd door een spatie en een hoofdletter tegen komt.

Voor de initialen heb ik het idee om VB te laten zoeken naar hoofdletters eindigend met een punt en een spatie.

Voor de tussenvoegsels wil ik VB laten zoeken op kleine letters tot aan de eerst volgende hoofdletter

en de naam, is dan hetgene wat overblijft.

Kan dit met Case of moet dit anders?

Hoe krijg ik VB zover dat ie dit doet??

En het probleem is dus ook dat je op de ene vraag ja kan zeggen en op de andere nee.
Dus ik heb wel al iets, maar ik kom niet verder.

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, Voorletters As String, Titel As String, Aanhef As String


Aanhef = MsgBox("Bevat het bestand een Aanhef", vbYesNo)
Titel = MsgBox("Bevat het bestand Titels?", vbYesNo)
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))

If Aanhef = vbYes Then
Aanhef = Replace(Trim(c.Value), " ", " ")
Y = 0
Spatie(1) = 0
For X = 1 To Len(Aanhef) ' Zoeken naar eerste spatie
If Mid(Aanhef, X, 1) = " " Then
Y = Y + 1
Spatie(Y) = X
If StopZoek = vbYes Then Exit For ' Voorvoegsels bij Achternaam.
End If
If Aanhef = vbNo Then
End If
Next

If Spatie(1) <> 0 Then
If Titel = vbYes Then
If Aanhef = vbNo Then
Titel = Replace(Trim(c.Value), " ", " ")
Y = 0
Spatie(1) = 0
For X = 1 To Len(Aanhef) ' Zoeken naar eerste spatie
If Mid(Titel, X, 1) = " " Then
Y = Y + 1
Spatie(Y) = X
If Spatie(1) <> 0 Then
If Aanhef = vbYes Then
If Titel = vbYes Then
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

Met vriendelijke groeten

Erik Smit

Groetjes

Erik