Sub test()

On Error Resume Next

Set 表 = ActiveDocument.Tables(1)

行數(shù) = 表.Rows.Count

列數(shù) = 表.Columns.Count

For 列 = 列數(shù) To 1 Step -1

For i = 1 To 行數(shù)

??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)) <> 行數(shù) Then

??s1 = s1 & "、" & 行數(shù) + 1

??Debug.Print Mid(s1, 4)

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

??For 下標(biāo) = UBound(arr) To LBound(arr) Step -1

????Debug.Print arr(下標(biāo))

????Debug.Print arr(下標(biāo) + 1) - 1

????表.Cell(arr(下標(biāo)), 列).Merge 表.Cell(arr(下標(biāo) + 1) - 1, 列)

??Next

?End If

s = ""

s1 = ""

Erase arr

Next

End Sub