• 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.

de eerste hoofdletter in een tekst vinden

Status
Niet open voor verdere reacties.
Roncancio,
Zo ziet de Excel regel eruit:


123456789 JH van der Doelen 23-2-1962 Man "Schoolstraat 10
1234AB UTRECHT
NL"


Waarbij tussen de 10 en postcode en tussen UTRECHTen NL, 2 omkaderde vraagtekentjes staan. Deze worden hier niet afgebeeld.
In veld A staat het lidmaatschapnummer.

NL mag weg

Met vriendelijke groet,

Gerard
 

Bijlagen

  • regel.png
    regel.png
    33,2 KB · Weergaven: 72
De volgende stap:

Code: 
Sub Namen()
Dim lRij As Long
Dim lLRij As Long
Dim rB As Range
Dim iPos As Integer
Dim sVN As String
Dim iBG As Integer
Dim iLng As Integer

    With Range("A:A")
        .Replace " VAN ", " van "
        .Replace " DE ", " de "
        .Replace " DEN ", " den "
        .Replace " DER ", " der "
    
    End With
    
    lRij = 1
    lLRij = Range("A" & Rows.Count).End(xlUp).Row
    While lRij <= lLRij
        Set rB = Range("A" & lRij)
        iBG = InStr(1, rB, " ")
        For iLng = iBG To Len(Range("A" & lRij).Value)
            If Mid(rB, iLng, 1) Like "[A-Z]" Then
                Range("B" & lRij).Value = WorksheetFunction.Proper(Mid(rB, iLng, Len(rB)))
                If Mid(rB, 2, 1) <> "." Then
                    For iPos = 1 To iBG
                        sVN = sVN & Mid(rB, iPos, 1) & "."
                    Next
                    Range("C" & lRij).Value = Left(sVN, Len(sVN) - 1)
                    sVN = ""
                Else
                    Range("C" & lRij).Value = Left(rB, iBG)
                End If
                Range("D" & lRij).Value = Mid(rB, iBG, iLng - iBG - 1)
                iLng = Len(rB)
            End If
            
        Next
        lRij = lRij + 1
        Application.StatusBar = "Rij " & lRij & " van " & lLRij
    Wend
    Application.StatusBar = False
End Sub

2 wijzigingen tov de vorige code:
- een aantal voorvoegsels worden met kleine letters weergegeven.
- Alleen de beginletter van de achternamen is een hoofdletter.

Dus:
C VAN DER DOELEN

.. wordt...

Doelen | C. | van der

Edit: je vorige reactie heb ik niet in de code meegenomen. Deze zag ik pas nadat ik de code had geplaatst.

Met vriendelijke groet,


Roncancio
 
Laatst bewerkt:
Hallo Roncancio,

Hartelijk dank voor het script, werkt prima, ben er erg blij mee.
Als je voor mijn laatst gemelde probleem ook nog een oplossing hebt (binnen hetzelfde script)
ben ik helemaal gelukkig.

Met vriendelijke groet,

Gerard
 
Ervan uitgaande dat de adresgegevens in de E-kolom staan:
Code: 
Sub Namen()
Dim lRij As Long
Dim lLRij As Long
Dim rB As Range
Dim iPos As Integer
Dim sVN As String
Dim iBG As Integer
Dim iLng As Integer

    With Range("A:A")
        .Replace " VAN ", " van "
        .Replace " DE ", " de "
        .Replace " DEN ", " den "
        .Replace " DER ", " der "
    
    End With
    
    lRij = 1
    lLRij = Range("A" & Rows.Count).End(xlUp).Row
    While lRij <= lLRij
        Set rB = Range("A" & lRij)
        iBG = InStr(1, rB, " ")
        For iLng = iBG To Len(Range("A" & lRij).Value)
            If Mid(rB, iLng, 1) Like "[A-Z]" Then
                Range("B" & lRij).Value = WorksheetFunction.Proper(Mid(rB, iLng, Len(rB)))
                If Mid(rB, 2, 1) <> "." Then
                    For iPos = 1 To iBG
                        sVN = sVN & Mid(rB, iPos, 1) & "."
                    Next
                    Range("C" & lRij).Value = Left(sVN, Len(sVN) - 1)
                    sVN = ""
                Else
                    Range("C" & lRij).Value = Left(rB, iBG)
                End If
                Range("D" & lRij).Value = Mid(rB, iBG, iLng - iBG - 1)
                iLng = Len(rB)
            End If
            
        Next
        lRij = lRij + 1
        Application.StatusBar = "Rij " & lRij & " van " & lLRij
    Wend
    Range("E1:E" & lRij).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    Application.StatusBar = False
End Sub

Met vriendelijke groet,


Roncancio
 
Bedankt Roncancio,

Ik heb je script al enkele malen geprobeerd, maar er komt geen splitsing van de adresvelden tevoorschijn.
Als je de laatse 2 scripts met elkaar vergelijk zie ik dat de op 2 na laatste regel het veschil maakt:
Range("E1:E" & lRij).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Gaat het hier wel goed?

met vriendelijke groet,

Gerard
 
Dat klopt omdat ik er vanuit ging dat de adresgegevens in de E-kolom staan.
Wat het beste werkt is als je een Excelbestand met een zeer klein gedeelte van de adressenlijst (met fictieve gegevens !) hier plaatst zodat ik de code kan afstemmen.

Met vriendelijke groet,


Roncancio
 
kolommen: lidmaatschapnr.;Naam;geb.datum;geslacht;adres
Let ook s.v.p. op Hoofdletters in adres, deze mogen natuurlijk ook met kleine letters voorafgegaan door 1 hoofdletter.

5496345 A Janssen 2-1-1957 Man "SPOORSTRAAT 3
1000AA AMSTERDAM
NL"
3456789 S. de la Bie 17-11-1945 Vrouw "Ambachtstraat 3
1034SA AMSTERDAM
NL"
4325679 FGH VAN DER GROOT 22-01-1977 Man "Verl.Grindweg12
1023AE AMSTERDAME
NL"

Eerder liep het script "vast" omdat er in een naam geen voorletters vermeld werden, misschien heb je ook hier
een oplossing voor?


Met vriendelijke groet,

Gerard
 
Kan je een kopie van het Excelbestand (met fictieve gegevens) sturen zodat ik kan zien in welke kolom/cel welke gegevens staan.
Dus een bestand uploaden.

Met vriendelijke groet,


Roncancio
 
Naar welk emailadres mag ik het sturen?

Met vriendelijke groet,

Gerard
 
Het makkelijkste is om het hier op het forum te plaatsen dmv de paperclip in het menu.

Met vriendelijke groet,


Roncancio
 
Bij deze dan (moest wel even zoeken naar de paperclip, gelukkig had mijn zoon een magneet)

Met vriendelijke groeten,

Gerard
 

Bijlagen

Kijk, nu komen we ergens!:thumb:

Ik heb wat koppen in het bestand geplaatst.
Verder heb ik een testlid (genaamd TEST Jansen) toegevoegd met hetzelfde adres als de andere Jansen.
Uiteraard is de code ook aangepast.

De code voegt 3 kolommen toe en zit in die 3 kolommen de onderverdeling van de namen (voorletters, achternaam, event. voorvoegsels).
Aan het eind van de code wordt een filtering geplaatst adhv van de adressen zodat een adres maar 1 keer voorkomt.
Dus de regel van TEST Jansen wordt verborgen maar nog niet verwijderd. Dat kan altijd nog wel.

Met vriendelijke groet,


Roncancio
 

Bijlagen

Jazeker we komen er wel, maar laat ik nu gedacht hebben dat dit om het uiteentrekken van de adressen ging?:p

Dit is zelfs alweer een stap verder, geweldig.
Maar heb je nu alleen dubbele adressen geselecteerd, of ook op naam? Want er wonen best wel verschillende mensen op hetzelfde adres.
Kun je van de dubbele adressen en namen in de "overgebleven" regel, "Man" of "Vrouw" vervangen door "Fam."?
Kun je de benamingen van "Vrouw" wijzigen in "Mevr." en "Man" wijzigen in "Dhr."?
Kun je in een aparte kolom t.b.v. mailing de teksten "heer" en "mevrouw" en "familie" toevoegen daar waar in de andere kolom "Man";"Vrouw";"Fam." staat?

En tot slot, als er later een criterium bijkomt in de beoordeling welke regels "dubbel" zijn, waar plaats ik deze?
b.v. als in een kolom het soort lidmaatschap gewogen moet worden.

Alvast bedankt,
met vriendelijke groet,

Gerard
 
Op blad1 zie je het resultaat van de code.
Op blad2 zie je de oorspronkelijke gegevens.

Met vriendelijke groet,


Roncancio
 

Bijlagen

Hartelijk dank Roncancio,
Had je ook rekening gehouden met mijn laatste verzoek betreffende dubbele adressen maar verschillende namen?
Want ik mis in de opgave 3 leden welke niet geselecteerd zijn.
Zie bijgaand bestandje waar voor het gemak de originele regels onderaan geplaatst staan, en de niet meegenomen regels in het geel vermeld staan.

Met vriendelijke groet,

Gerard
 

Bijlagen

In de code wordt nog geen rekening gehouden met verschillende achternamen op 1 adres.
Dat zal ik de komende tijd naar kijken.

Met vriendelijke groet,


Roncancio
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan