Voornamen omzetten in voorletters voorzien van hoofdletters en punten

[Robert Smidt]

Hallo beste mensen,

Ik ben opzoek naar een macro die voor mij in Excel in kolom E alle voornamen wijzigt in voorletters, als voorbeeld: Joke Anna Maria moet worden J.A.M.

Alvast hartelijk bedankt.

Gegroet, Robert

 

[OctaFish]

Met deze functie moet het lukken.

Function NaarHoofdletter(Celletje) As String
Dim sq
Dim i As Integer

If InStr(1, Celletje, " ") > 0 Then
    sq = Split(Celletje, " ")
    For i = LBound(sq) To UBound(sq)
        NaarHoofdletter = NaarHoofdletter & UCase(Left(sq(i), 1)) & "."
    Next i
Else
    NaarHoofdletter = UCase(Left(Celletje, 1)) & "."
End If

End Function

 

[Robert Smidt]

Helaas geen resultaat

Hoi Michel,

Helaas het werkt niet, waarschijnlijk om dat ik nog met de antieke versie 97 werk. Deze versie moet je de macro beginnen met Sub .... als je dat niet doe kan Excel de macro niet vinden.

Ik hoop dat je de oplossing hebt.

Robert

 

[HSV]

De code werkt prima (UDF - eigen gemaakte formule).

De naam is een beetje ongelukkig gekozen.

Zet het in een standaardmodule.
Zet in A1: Joke Anna Maria
Zet in B1: =Hoofletters(A1); Let op: er staat geen "d" in het woord "Hoofletters.

 

[OctaFish]

Dat krijg je met Hagenezen Ik heb uiteraard wel een d op mijn toetsenbord zitten...

 

[HSV]

Hahahaha, Het is maar goed dat je de "d" miste in je typesnelheid, anders was de tekst verschenen in hoofdletters door de standaardfunctie "=HOOFDLETTERS".

 

[Robert Smidt]

Sorry voor de late reactie

Beste mensen,

De code werkt niet. Kan het zijn dat het komt omdat ik met Excel 97 werk. Of doe ik iets fout omdat ik het in een macro zet want zoals de code hierboven beschreven is kan ik dat niet in een macro opslaag.

Hopelijk heeft iemand de oplossing.

Groeten, Robert

 

[E v R]

De VBA functie split (en Join) bestaan nog niet in XL97

 

[Robert Smidt]

helaas

bedankt voor de reactie, maar is er geen alternatief

 

[E v R]

Een methode voor XL97:

Sub NaarHoofdLetters()
Dim Cel As Range, x As Integer, Afkorting As String
    For Each Cel In Range("E1", Cells(Rows.Count, 5).End(xlUp))
    Afkorting = Left(Cel, 1) & "."
        For x = 2 To Len(Cel)
            If Mid(Cel, x, 1) = " " Then
                Afkorting = Afkorting & Mid(Cel, x + 1, 1) & "."
            End If
        Next
        Cel = UCase(Afkorting)
    Next
End Sub

 

[Robert Smidt]

Bedankt

Eric,

bedankt voor jouw snelle reactie. Helaas kan ik het nu niet uitproberen aangezien het probleem zich voordoet bij mijn werkgever. Maandag zal direct kijken of deze werkt.

Nogmaals bedankt en een fijn weekend.

groeten, Robert

 

[Robert Smidt]

De code werkt

Eric,

Zojuist de code getest en het werk prima mijn dank hiervoor...echter heb ik iets over het hoofd gezien. De kolom met vooramen bevatten soms namen van ondernemingen en die moeten niet gewijzigd worden.

Nu valt het mij op dat de namen van die ondernemingen alleen uit hoofdletters bestaan met of zonder een combinatie van punten.

Dus mijn verzoek; kan er een code aan toegevoegd worden die deze cellen niet wijzigen.

Alvast hartelijk bedankt.

Robert

 

[E v R]

Dat wordt al wat lastiger, heb je een gelijkend voorbeeldje met alle mogelijke variaties?

 

[Robert Smidt]

voorbeeld

Eric,

Bedoel jij of ik een voorbeeld heb met een databestand, het betreft bestaande ondernemingen die ik niet kan meezenden wel kan ik je fictief voorbeeld doen:

In kolom E staan voornamen bijv.
Joke Anna Maria

Echter staan er soms ook namen van BV's in bijv.
ABACADABRA
V.O.F.
BV

Deze laatste moeten ongewijzigd blijven.

 

[E v R]

Met een controle op punten en op een hoofdletter op de 2e positie:

Sub NaarHoofdLetters()
Dim Cel As Range, x As Integer, Afkorting As String
    For Each Cel In Range("E1", Cells(Rows.Count, 5).End(xlUp))
    If InStr(1, Cel, ".") > 0 Or Mid(Cel, 2, 1) = UCase(Mid(Cel, 2, 1)) Then
    Afkorting = Cel
    Else
     Afkorting = Left(Cel, 1) & "."
        For x = 2 To Len(Cel)
            If Mid(Cel, x, 1) = " " Then
                Afkorting = Afkorting & Mid(Cel, x + 1, 1) & "."
            End If
        Next
        End If
        Cel = UCase(Afkorting)
    Next
End Sub

 

[Robert Smidt]

werkt prima, ook onder excel 97

Dag Eric,

Wederom werkt de door jou toegestuurde code perfect.

Met hartelijke groet,
Robert Smidt