|
首先感谢守柔老师的多次帮助，在他的指导下修改了一下（插入非空行于表尾），现在可多次合并，以下是代码，希望对大家有用，更欢迎各位老师加以改进，谢谢！！！
Sub IntelliMerge()
If MsgBox("请确认有表格需要智能合并（纵向）。", vbOKCancel + vbInformation, "智能合并") = vbOK Then
Set mytab = ActiveDocument.Tables(1)
On Error Resume Next
mytab.Rows(mytab.Rows.Count).Select
Selection.InsertRowsBelow 1
mytab.Cell(mytab.Rows.Count, 1) = " "
For i = 1 To mytab.Rows.Count
If mytab.Cell(i, 1).Range.End - mytab.Cell(i, 1).Range.Start > 1 Then
For n = i + 1 To mytab.Rows.Count
If mytab.Cell(n, 1).Range.End - mytab.Cell(n, 1).Range.Start > 1 Then
mytab.Cell(i, 1).Merge MergeTo:=mytab.Cell(n - 1, 1)
Exit For
End If
Next n
End If
Next i
mytab.Rows(mytab.Rows.Count).Select
Selection.Rows.Delete
End If
End Sub
[此贴子已经被作者于2003-11-10 18:56:22编辑过] | 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2003-11-10 18:33
楼主
