从单个字符串中提取缩写

Question

我希望使用左，中和其他类似功能从单个文本框提取缩写。用户输入其第一个，中间姓名和姓氏；假设空间和中间初始文字之后的一段时间。我需要确保提取的缩写是大写，即使文本以小写输入。可以在VBA中实现此操作的代码中的任何帮助，将不胜感激。我能够单独使用这些功能，但是编码的新功能，并且不确定如何正确将它们串在一起。

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

这是我所获得的，我知道这是不正确的，因为我不知道如何考虑三个单独的名称。

Answer 1

这是基于REGEX的函数。我敢肯定，有人会改进它，我的VBA正则是生锈的。它基于此处的正则表达式，您可以在其中看到IT匹配的示例。如果您根本不熟悉Regex，那么它们最初令人恐惧，这超出了解释它们的答案的范围。

但是，它通过将任何输入分解为5个字符串而起作用：

1. 名字的初始字符
2. 名称的其余部分
3. 初始和。如果存在
4. 姓氏的首字母
5. 姓氏的其余部分

然后，使用一些简单的ucase和lcase，您可以编译需要格式的名称。您可能需要更改逻辑 - 您确实暗示将有一个中间的缩写，但假设它不会总是存在，并且在首字母可能会或可能不存在之后的点。

注意：您需要在excel 中启用正则表达式

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

导致

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

编辑：我误读了问题，如果您只想首字母缩写，请像这样替换函数的最后一部分：

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))

给出：

rdh
RDH
RDH
RDH
RH
RDH

Answer 2

这是我已经使用了一段时间的代码。它将还包括双管名称的缩写。

?GetInitials("Darren Bartrup-Cook")将返回DBC。
?GetInitials("The quick brown fox jumps over the lazy dog")将返回tqbfjotld。

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