☰

如何在 Microsoft Word 上将单行转换为多行？

tag-icon • tag-icon microsoft-word vba
如何在 Microsoft Word 上将单行转换为多行？

我有一张表格，其中每一行都包含大量英语和土耳其语对等词。每行右侧单元格中都有很多土耳其语句子，而每个土耳其语句子的左侧单元格正前方都写有其对应的英语对等词。因此，每行包含两个单元格；右侧单元格包含五个土耳其语句子，左侧单元格包含五个对应的英语对等词。现在，我需要将每行分成单独的行，每行分别包含土耳其语和英语对等词。Microsoft Word 能否通过技巧做到这一点，还是我需要插入单独的行并手动移动内容？
我很清楚我也可以使用 Word 的铅笔，但问题是：

  1. 桌子太大了。
  2. 这可能会导致一些错误。

为了说明这一点，让我通过两张图片来阐明我的意图：

我需要Word来更改以下行：

同一行

自动进入下一个；

单独的行

我想知道我怎样才能做到这一点？

答案1

首先，在运行此 VBA 宏之前，备份您宝贵的​​文件。

您尚未使用“VBA”标签标记您的问题。如果您同意，请将此标签添加到 OP。

编辑：添加了一个新版本的第一个发布的代码来处理段落，保存文本格式（大小，颜色等）。

还补充道：

  1. 检查是否仅处理具有 2 列的表。
  2. 每个新单元中的 ^p 替换。

新版本：

Option Explicit

Sub fnSplitCellsInNewTableRows()
    Dim oTables As Word.Tables 'all document tables
    Dim oTable As Word.Table ' each document table
    Dim intLenOldLines As Integer
    Dim intLenNewLines As Integer
    Dim oLeftPars As Word.Paragraphs 'Paragraphs on the left cell
    Dim oRightPars As Word.Paragraphs 'Paragraphs on the right cell
    Dim intRow As Integer
    Dim intTable As Integer
    Dim intTableRow As Integer
    Dim intTableRows As Integer
    Dim intTablesCount As Integer
    Dim oLeftPar As Word.Paragraph 'unique (left) paragraph to work with
    Dim oRightPar As Word.Paragraph 'unique (right) paragraph to work with
    Dim oTableRange As Word.Range 'used to Find/Replace ^p

    Set oTables = ThisDocument.Tables
    intTablesCount = oTables.Count
    
    For intTable = 1 To intTablesCount
        Set oTable = oTables(intTable)
        If oTable.Columns.Count <> 2 Then
            MsgBox "A table with " & oTable.Columns.Count & " was discharged."
            GoTo lblNextTable
        End If
        intTableRows = oTable.Rows.Count
        For intRow = 1 To intTableRows
            intLenOldLines = Len(oTable.Rows(intRow).Cells(1).Range.Text)
            intLenNewLines = Len(VBA.Replace(oTable.Rows(intRow).Cells(1).Range.Text, Chr(13), ""))
            
            'compare the amount of chr(13) ocurrences
            'each one determine a new inner line on the cell text, except for the last one.
            If intLenOldLines > intLenNewLines + 1 Then
                Set oLeftPars = oTable.Rows(intRow).Cells(1).Range.Paragraphs
                Set oRightPars = oTable.Rows(intRow).Cells(2).Range.Paragraphs
                oTable.Rows(intRow).Cells.Split (intLenOldLines - intLenNewLines) + 1, 1

                For intTableRow = oTable.Rows.Count To 2 Step -1
                    Set oLeftPar = oLeftPars(intTableRow - 1)
                    Set oRightPar = oRightPars(intTableRow - 1)
                    oTable.Rows(intTableRow).Cells(1).Range.FormattedText = oLeftPar.Range.FormattedText
                    oTable.Rows(intTableRow).Cells(2).Range.FormattedText = oRightPar.Range.FormattedText

                Next

            End If
            ThisDocument.Save
            oTable.Rows(1).Delete ' the original row
            
            'this piece of code strips out ^p on each new cell
            oTable.Select
            Set oTableRange = oTable.Range
            With oTableRange.Find
                .ClearFormatting
                .Text = "^p"
                With .Replacement
                    .ClearFormatting
                    .Text = ""
                End With
                .Execute Replace:=wdReplaceAll, _
                    Format:=True, MatchCase:=True, _
                    MatchWholeWord:=True
            End With

            ThisDocument.Save
        Next
        
lblNextTable:
    Next
    
    DoEvents
    MsgBox "Done."

End Sub

旧版本适用于纯文本（不带格式元素）：

下面的 VBA 宏会获取文档中所有现有的表格，根据您发布的图像，这些表格的单行将分为（在示例中）5 行。单元格文本范围（由 'Enter' = Chr(13) 创建）的每个内行都将填充新行，但第一行除外，它将保留在现有单元格中。

Option Explicit

Sub fnSplitCellsInNewTableRows()
    Dim oTables As Word.Tables
    Dim oTable As Word.Table
    Dim oRow As Word.Row
    Dim oSplittedRow As Word.Row
    Dim arrLeftInnerLines() As String
    Dim arrRightInnerLines() As String
    Dim intLenOldLines As Integer
    Dim intLenNewLines As Integer
    Dim intLine As Integer
    
    Set oTables = ThisDocument.Tables

    For Each oTable In oTables
        For Each oRow In oTable.Rows
            intLenOldLines = Len(oRow.Cells(1).Range.Text)
            intLenNewLines = Len(VBA.Replace(oRow.Cells(1).Range.Text, Chr(13), ""))
            
            'compare the amount of chr(13) ocurrences
            'each one detrmine a new inner line on the cell text, except the last one.
            If intLenOldLines > intLenNewLines + 1 Then
                'loading each inner line on an array
                'notice that Word has it's own Split function - we don't want it now
                arrLeftInnerLines = VBA.Split(oRow.Cells(1).Range.Text, Chr(13))
                arrRightInnerLines = VBA.Split(oRow.Cells(2).Range.Text, Chr(13))
                oRow.Cells.Split (intLenOldLines - intLenNewLines), 1
                
                For Each oSplittedRow In oTable.Rows
                    oSplittedRow.Cells(1).Range.Text = arrLeftInnerLines(intLine)
                    oSplittedRow.Cells(2).Range.Text = arrRightInnerLines(intLine)
                    intLine = intLine + 1
                    If intLine = UBound(arrLeftInnerLines) Then
                        Exit For
                    End If
                Next
                
            End If
            
        Next
    Next
    
MsgBox "Done."

End Sub

相关内容