Extrahieren von Initialen aus einer einzigen Zeichenfolge

Question

Ich bin auf der Suche nach Initialen aus einem einzigen Textfeld mit Links, Mitte und andere ähnliche Funktionen extrahieren. Der Benutzer gibt seinen ersten, mittleren Anfangs- und Nachnamen ein; angenommene Leerzeichen und eine Periode nach der mittleren Initiale. Ich muss sicherstellen, dass die extrahierten Initialen Großbuchstaben sind, auch wenn der Text in Kleinbuchstaben eingegeben wird. Jede Unterstützung in einem Code, der dies in VBA für Access erreichen kann, wäre willkommen. Ich bin in der Lage, die Funktionen einzeln zu verwenden, bin aber neu im Codieren und bin mir nicht sicher, wie man sie richtig aneinander reiht.

Private Sub cmdGreeting_Click() 
strOutput = Left(txtInput.Value, 1) & Mid(txtinput.value, 1) & Right(txtinput.value, 1) 
lblOutput.Caption = strOutput 
End Sub 

Dies ist so weit wie ich bekommen habe, und ich weiß, dass es falsch ist, weil ich keine Ahnung, wie für die 3 separaten Namen zu berücksichtigen.

Answer 1

Hier ist eine Funktion basierend auf Regex. Ich bin mir sicher, dass jemand eingreifen wird, um es zu verbessern, mein VBA Regex ist rostig. Es basiert auf der Regex here, wo Sie Beispiele dafür finden können. Wenn Sie mit Regex überhaupt nicht vertraut sind, sind sie anfänglich beängstigend und es ist jenseits des Rahmens einer Antwort, sie zu erklären.

Allerdings funktioniert es durch die Eingabe in 5 Saiten brechen:

1. Anfangs Charakter des Vornamens
2. Rest des Namens
3. Anfangs- und. falls vorhanden
4. Anfangsbuchstabe des Nachnamens
5. Rest Zuname

Dann mit einigen einfachen UCase und LCase, Sie kompilieren können die benötigen, formatierten Namen. Vielleicht möchten Sie die Logik ändern - Sie haben impliziert, dass es eine mittlere Initiale geben würde, aber das geht davon aus, dass sie nicht immer da sein wird, und der Punkt nach der Initiale kann oder darf nicht da sein.

Hinweis: Sie müssen regex in Excel ermöglichen - instructions

Sub normalise() 
    Debug.Print (proper("Reginald D. Hunter")) 
    Debug.Print (proper("reginald D. hunter")) 
    Debug.Print (proper("rEGINALD d. Hunter")) 
    Debug.Print (proper("Reginald D Hunter")) 
    Debug.Print (proper("Reginald Hunter")) 
    Debug.Print (proper("Reginald  D.  Hunter")) 
End Sub 

Function proper(text) As String 

    Dim regexMatch As Object 
    Dim matches As Object 

    With New RegExp 
     .Global = False 
     .MultiLine = False 
     .IgnoreCase = False 
     .Pattern = "([a-zA-Z])([^ ]*)\s*([a-zA-Z]?[. ])?\s*([a-zA-Z])([^ ]*)" 
     If .test(text) Then 
      For Each regexMatch In .Execute(text) 
       Set matches = regexMatch.SubMatches 
      Next 
     End If 
    End With 
    proper = UCase(matches(0)) + LCase(matches(1)) 
    If Trim(matches(2)) <> "" Then 
     If InStr(matches(2), ".") Then 
      proper = proper + " " + Trim(UCase(matches(2))) + " " 
     Else 
      proper = proper + " " + Trim(UCase(matches(2))) + ". " 
     End If 
    Else 
     proper = proper + " " 
    End If 
    proper = proper + UCase(matches(3)) + LCase(matches(4)) 
End Function 

Ergebnisse in

Reginald D. Hunter
Reginald D. Hunter
Reginald D. Hunter
Reginald D Hunter
Reginald Hunter
Reginald D. Hunter

Edit: Ich die Frage falsch verstanden und wenn Sie nur Initialen wollen dann den letzten Teil der Funktion ersetzen etwa so:

proper = UCase(matches(0)) 
If Trim(matches(2)) <> "" Then 
    If InStr(matches(2), ".") Then 
     proper = proper + Replace(Trim(UCase(matches(2))), ".", "") 
    Else 
     proper = proper + Trim(UCase(matches(2))) 
    End If 
End If 
proper = proper + UCase(matches(3)) 

gibt:

RDH
RDH
RDH
RDH
RH
RDH

Answer 2

Dies ist der Code, den ich seit einer Weile verwende. Es wird auch die Initialen von doppelläufigen Namen enthalten.

?GetInitials("Darren Bartrup-Cook") wird DBC zurückgeben.
?GetInitials("The quick brown fox jumps over the lazy dog") wird TQBFJOTLD zurückgeben.

Public Function GetInitials(FullName As String) As String 

    Dim RegEx As Object 
    Dim Ret As Object 
    Dim RetItem As Object 

    On Error GoTo ERR_HANDLE 

    Set RegEx = CreateObject("VBScript.RegExp") 
    With RegEx 
     .IgnoreCase = True 
     .Global = True 
     .Pattern = "(\b[a-zA-Z])[a-zA-Z]* ?" 
     Set Ret = .Execute(FullName) 
     For Each RetItem In Ret 
      GetInitials = GetInitials & UCase(RetItem.Submatches(0)) 
     Next RetItem 
    End With 

EXIT_PROC: 
     On Error GoTo 0 
     Exit Function 

ERR_HANDLE: 
     'Add your own error handling here. 
     'DisplayError Err.Number, Err.Description, "mdl_GetInitials.GetInitials()" 
     Resume EXIT_PROC 

End Function