Word VBA 批量自动识别需要合并的单元格

Sub test()

On Error Resume Next

Set 表 = ActiveDocument.Tables(1)

行数 = 表.Rows.Count

列数 = 表.Columns.Count

For 列 = 列数 To 1 Step -1

For i = 1 To 行数

  If 表.Cell(i, 列).Range = Chr(13) & Chr(7) Then

    s = s & "0"

  Else

    s = s & "1"

  End If

Next

For j = 1 To Len(s)

  If Mid(s, j, 1) = "1" Then

    s1 = s1 & "、" & j

  End If

Next

If Val(Mid(s1, InStrRev(s1, "、") + 1)) <> 行数 Then

  s1 = s1 & "、" & 行数 + 1

  Debug.Print Mid(s1, 4)

  arr = Split(Mid(s1, 4), "、")

  For 下标 = UBound(arr) To LBound(arr) Step -1

    Debug.Print arr(下标)

    Debug.Print arr(下标 + 1) - 1

    表.Cell(arr(下标), 列).Merge 表.Cell(arr(下标 + 1) - 1, 列)

  Next

 End If

s = ""

s1 = ""

Erase arr

Next

End Sub