vba - 如何拆分包含“硬回报”的单元格

Question

如何拆分包含“硬返回”（段落标记）的单元格，如下图所示？

期望的结果：

这是我的代码

Sub SplitCells()
'
Dim selT As String
Dim arr
Dim i As Integer
selT = selection.Range.Text    
arr = Split(selT, ChrW(13))    
selection.Range.Cut   

  selection.Cells.Split NumRows:=UBound(arr) + 1, NumColumns:=1, MergeBeforeSplit:=False

  selection.MoveDown wdLine, 1
For i = UBound(arr) To 0 Step -1
  selection.MoveUp wdLine, 1
  selection.TypeText arr(i)
Next
End Sub

它有效，但我觉得这段代码很笨拙，希望有人能告诉我一个优雅的方式。

标签： vbams-word

Answer 1

它没有什么问题，真的。为了在具有拆分/合并单元格的表格中向上/向下移动，您需要Selection...

这是使用对象模型而不是Selection尽可能多的代码。但我不确定我会称之为“更优雅”还是“不那么笨拙”。可能，因为它尽可能使用 Word 对象，所以它更具自我记录性。

我所做的一项更改是在执行任何操作之前测试选择是否在表格中。如果用户在没有进行此类测试的情况下忘记选择一个单元格，则会显示一个神秘的错误消息，这总是很烦人......

Sub SplitCells()
'
    Dim cel As Word.Cell
    Dim selT As String
    Dim arr
    Dim i As Integer
    Dim nrCells As Long

    If Selection.Information(wdWithInTable) Then
        Set cel = Selection.Cells(1)
        selT = cel.Range.Text
        arr = Split(selT, ChrW(13))
        nrCells = UBound(arr)
        cel.Range.Delete

        cel.Split NumRows:=nrCells, NumColumns:=1 ', _
                  'MergeBeforeSplit:=False
        cel.Select
        Selection.MoveDown wdLine, nrCells - 1
        For i = nrCells - 1 To 0 Step -1
            Set cel = Selection.Cells(1)
            cel.Range.Text = arr(i)
            cel.Select
            Selection.MoveUp wdLine, 1
        Next
    Else
        MsgBox "Please select a table cell and try again."
    End If
End Sub