Question

我希望使用Left，mid和其他类似函数从单个文本框中提取首字母。用户输入他们的第一个，中间的姓氏和名字;假设空格和中间初始后的一段时间。我需要确保提取的首字母是大写的，即使文本是以小写形式输入的。可以在VBA for Access中完成此任务的代码中的任何帮助。我可以单独使用这些功能，但我不熟悉编码，也不确定如何正确地将它们串在一起。

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

据我所知，我知道这是不正确的，因为我不知道如何解释3个不同的名字。

Answer 1

这是一个基于正则表达式的函数。我确信有人会改进它，我的VBA正则表达式是生锈的。它基于正则表达式here，您可以在其中查看匹配的示例。如果你根本不熟悉正则表达式，那么它们最初会令人恐惧，并且超出了解释它们的答案范围。

但是，它可以将任何输入分成5个字符串：

名字的首字母
名称的剩余部分
初始和。如果存在
姓氏的首字母
姓氏的剩余部分

然后，使用一些简单的UCase和LCase，您可以编译require，格式化的名称。您可能想要更改逻辑 - 您确实意味着会有一个中间的初始值，但这假设它不会永远存在，并且初始后的点可能会或可能不存在。

注意：您需要在Excel中启用正则表达式 - 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

结果

编辑：我误解了问题，如果您只想要缩写，那么请替换函数的最后一部分，如下所示：

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

从单个字符串

2 个答案: