将多个表格后的回车删除，使其后的表格连接成一个大表的VBA

cncalyl

TableJoiner() 是“目录类型邮件合并指引”帖子，目录合并成的一个个表格后的回车删除，连接成一个大表的VBA代码（老外写的）。我是480个两行16列的合并表格，运行起来奇慢无比，还不如我手工删除的快！在我的笔记本上运行一晚上也无反应，只有在我家的i7 920台式机上，运行半天，才得出结果。后分析估计是每个单元格都是一个段落，估计它是遍历了所有的单元格，所以才慢！
TableJoinerNew()是我写的，思路是循环文档中所有的表格，选择表的最后一行，然后下移一行跳出表格，再选择当前行，如果是回车，就删除。运行速度挺快的，结果似乎也是正确的。
我是首次写Word VBA代码，请守柔版主帮忙看看，是否写的啰嗦，有无问题，特别是否存在副作用。谢谢！

Sub TableJoiner()
Dim oPara As Paragraph
Application.ScreenUpdating = False    '关闭屏幕更新
For Each oPara In ActiveDocument.Paragraphs
  With oPara.Range
    If .Information(wdWithInTable) = True Then
      With .Next
        If .Information(wdWithInTable) = False Then
          If .Text = vbCr Then .Delete
        End If
      End With
    End If
  End With
Next
Application.ScreenUpdating = True    '打开屏幕更新
End Sub

'------------------------------
Sub TableJoinerNew()
Dim oTab As Table
Application.ScreenUpdating = False    '关闭屏幕更新
For Each oTab In ActiveDocument.Tables
    oTab.Cell(oTab.Rows.Count, 1).Select
    Selection.SelectRow
    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.HomeKey Unit:=wdLine
    Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
    If Selection.Range.Text = vbCr Then Selection.Range.Delete
Next
Application.ScreenUpdating = True    '打开屏幕更新
End Sub

szqhb

要传几页纸的附件来看看，再对症下药，如每两个表格之间有几个空行啊

sylun

如要简单的，可以试试如下代码当然，对文档有特别要求。

1. Sub test()
   
2.     Application.ScreenUpdating = False
   
3.     Do While ActiveDocument.Tables.Count > 1
   
4.         ActiveDocument.Tables(1).Range.Characters.Last.Next.Delete
   
5.     Loop
   
6.     Application.ScreenUpdating = True
   
7. End Sub
   

复制代码

[ 本帖最后由 sylun 于 2011-3-19 09:41 编辑 ]

cncalyl

十分感谢热心回复，给我很大启发！不过你的代码如果文档无表格，什么也不做；有表格，似乎是进入了死循环。修正为如下代码可行，且无副作用，完全可以代替老外写的效率极差的那段代码：
Sub TableJoinerNew()
Dim oTab As Table, cString As String
Application.ScreenUpdating = False    '关闭屏幕更新
For Each oTab In ActiveDocument.Tables
      With oTab.Range.Characters.Last.Next
              If .Characters.First = vbCr Then .Delete
      End With
Next
Application.ScreenUpdating = True    '打开屏幕更新
End Sub

[ 本帖最后由 cncalyl 于 2011-4-3 16:36 编辑 ]

ly001

谢谢,留下备用.......

vanhelman

With oTab.Range.Characters.Last.Next
可以再简练点吧---->
With oTab.Range.Next