Question

下面是由其他人建立的功能，将文本更改为句子大小写（每个句子的首字母大写）。该函数很好地工作，除了它没有大写第一个单词的第一个字母。另一个问题是，如果在所有大写字母中输入一个句子，则该函数不执行任何操作。我正在寻找一些帮助来调整功能来纠正这些问题。

Option Explicit 
Function ProperCaps(strIn As String) As String

Dim objRegex As Object
Dim objRegMC As Object
Dim objRegM As Object

Set objRegex = CreateObject("vbscript.regexp")
strIn = LCase$(strIn)

With objRegex
    .Global = True
    .ignoreCase = True
    .Pattern = "(^|[\.\?\!\r\t]\s?)([a-z])"

    If .test(strIn) Then
        Set objRegMC = .Execute(strIn)

        For Each objRegM In objRegMC
            Mid$(strIn, objRegM.firstindex + 1, objRegM.Length) = UCase$(objRegM)
        Next
    End If
End With

ProperCaps = strIn
End Function

谢谢，加里

Answer 1

我将该函数重命名为SentenceCase（）并进行了一些调整：

Public Function SentenceCase(ByVal str As String) As String
    Dim regEx As Object, regExM As Object, indx As Object, indxs As Object
    Set regEx = CreateObject("VBScript.RegExp")
    str = Replace$(str, vbNullChar, vbLf)
    str = Replace$(str, vbBack, vbLf)
    str = LTrim$(LCase$(str))
    With regEx
        .IgnoreCase = True
        .MultiLine = True
        .Global = True
        .Pattern = "(^|[\n\f\r\t\v\.\!\?]\s*)(\w)"
        If .Test(str) Then
            Set indxs = .Execute(str)
            For Each indx In indxs
                Mid$(str, indx.FirstIndex + 1, indx.Length) = UCase$(indx)
            Next
        End If
    End With
    SentenceCase = str
End Function

这是我用它测试的：

MsgBox SentenceCase(" UPPER CASE SENTENCE." & _
                    vbCrLf & "next line!nEXT sENTENCE" & _
                    vbCr & "cr ! lower case" & _
                    vbLf & "lf .new sentence" & _
                    vbNullChar & " null?null char" & _
                    vbNullString & "nullString  spaces" & _
                    vbTab & "TAB CHAR.ttt" & _
                    vbBack & "back?  back char" & _
                    vbFormFeed & "ff  ff words" & _
                    vbVerticalTab & "vertical tab.| lower .case words")

结果：

test 1

test 2

test 3

您可以在此处找到更多详细信息：Microsoft - Regular Expressions

Answer 2

保罗，谢谢你抽出时间帮忙。我放弃并搜索了网络，发现了一个可行的子网站，得到了另一个公告板的帮助，并提出了以下建议：

Sub SentenceCase(rng As Range) 
Dim V       As Variant 
Dim s       As String 
Dim Start   As Boolean 
Dim i       As Long 
Dim ch      As String 

Application.ScreenUpdating = False 
Application.EnableEvents = False 
ActiveSheet.Unprotect 

With rng 
    V = .Value 
    If IsDate(V) Or IsNumeric(V) Then Exit Sub 
    s = CStr(V) 
    Start = True 

    For i = 1 To Len(s) 
        ch = Mid$(s, i, 1) 
        Select Case ch 
        Case "." 
            Start = True 
        Case "?" 
            Start = True 
        Case "!" 
            Start = True 
        Case "a" To "z" 
            If Start Then ch = UCase$(ch) 
            Start = False 
        Case "A" To "Z" 
            If Start Then 
                Start = False 
            Else 
                ch = LCase$(ch) 
            End If 
        End Select 
        Mid$(s, i, 1) = ch 
    Next i 
    .Value = s 
End With 

ActiveSheet.Protect 
Application.ScreenUpdating = True 
Application.EnableEvents = True

End Sub

此代码正在执行我需要的操作。再次感谢您的帮助。

加里

Excel VBA句子案例功能需要微调

2 个答案: