当单元格中有多个段落时，如何将每个段落中的第一个字母大写？

Question

所以我有列表，其中每行中的一个单元格将包含一个段落或多个段落。我需要将这些标准化，以便它们在句子中。我已经构建了一些代码来执行此操作，如果只有一个段落，它就可以工作，但是当单元格中有多个段落或换行符时，它无法将第一个字母大写。我尝试使用换行符本身作为变量进行查找和替换，但这不起作用，我被卡住了。

我的大部分代码都将整个选定范围转换为 Lcase，然后进行一系列查找和替换，以使每个句子的第一个字母大写。

Selection.Replace What:=". a", Replacement:=". A"

我浏览了整个字母表，而不是用“！a”和“~？a”再做一遍

但如果前一段和新段落之间有换行符，则此技术将不起作用。

完成后，我使用范围选择将每个单元格中的第一个字母大写，但我不确定这有多相关。

For Each cell In RNG
cell.Value = UCase(Left(cell.Value, 1)) & Right(cell.Value, Len(cell.Value) - 1)
Next cell

再次感谢 Scott Craner 的回答！

Selection.Replace What:=Chr(10) & "A"

这解决了我的问题！

Answer 1

如果需要，我会尝试使用 RegEx 的方法为您提供更大的灵活性：

Sub LoopCellFormat()

For Each cell In RNG
cell.Value = StandardPar(Cell.Value)
Next cell

End Sub

Function StandardPar(ByVal txt As String) As String
 Dim m As Object
 txt = LCase(txt)

 txt = Application.Replace(txt, 1, 1, UCase(Left$(txt, 1)))
 Debug.Print txt

 With CreateObject("VBScript.RegExp")
 .Pattern = "[!\?\.][\s\n\r]+."
 .Global = True
 For Each m In .Execute(txt)

 txt = Application.Replace(txt, m.FirstIndex + 1, m.Length, UCase(m.Value))

 Next

 End With
 StandardPar = txt

End Function

要使用 RegEx，您应该在 VBA 编辑器中设置引用：

Answer 2

请试试这个代码：

Sub testProperCaseParagraph()
  Dim sh As Worksheet, arr As Variant, rng As Range, cel As Range
  Dim El As Variant, strProp As String

  Set sh = ActiveSheet 'use here your sheet
  Set rng = sh.Range("A14:B22") 'use here your range (I used it for testing purpose)
    For Each cel In rng
        arr = Split(cel.value, vbLf)
        For Each El In arr
            If strProp = "" and El <> "" Then
                strProp = UCase(left(El, 1)) & Right(El, Len(El) - 1)
            ElseIf El <> "" Then
                strProp = strProp & vbLf & UCase(left(El, 1)) & Right(El, Len(El) - 1)
            End If
        Next
        cel.value = strProp: strProp = ""
    Next
End Sub

Answer 3

这应该会让你走上正轨。对于此示例，单元格 A1 包含多个段落...

Sub ParagraphsCapitalize()

    Dim p&, s$

    s = [a1]

    p = InStr(s, vbLf)
    If p Then Mid(s, p + 1, 1) = UCase(Mid(s, p + 1, 1))

    Debug.Print s

End Sub

---

在这里我为你充实了它......

Sub Test()

    MsgBox ParagraphCaps([a1])

End Sub



Function ParagraphCaps$(s$)

    Dim p&
    Do
        p = InStr(p + 1, s, vbLf)
        If p Then Mid(s, p + 1, 1) = UCase(Mid(s, p + 1, 1))
    Loop While p
    Mid(s, 1, 1) = UCase(Mid(s, 1, 1))

    ParagraphCaps = s

End Function