怎么在word里的所有表格指定位置合并单元格

zlcdy

怎么在word里的所有表格指定位置合并单元格，求助
                                                                                      谢谢

chxw68

WORD代码

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr
   
4.   With ThisDocument
   
5.     For t = 1 To .Tables.Count
   
6.       With .Tables(t)
   
7.         r1 = 0
   
8.         r2 = 0
   
9.         For i = 1 To .Rows.Count
   
10.           If .Cell(i, 1).Range.Text = "距离(m)" & Chr(13) & Chr(7) Then
    
11.             r1 = i
    
12.           ElseIf .Cell(i, 1).Range.Text = "备注信息" & Chr(13) & Chr(7) Then
    
13.             r2 = i
    
14.           End If
    
15.         Next
    
16.         If r1 <> 0 And r2 <> 0 Then
    
17.           For i = r1 To r2 - 1
    
18.             If .Rows(i).Cells.Count >= 7 Then
    
19.               .Cell(i, 6).Range.Text = Empty
    
20.               .Cell(i, 6).Merge mergeto:=.Cell(i, 7)
    
21.             End If
    
22.           Next
    
23.         End If
    
24.       End With
    
25.     Next
    
26.   End With
    
27. End Sub
    
28. 
    

复制代码

chxw68

详见附件。

Jason_WangSS

1. Sub 合并单元格()
   
2.     Dim oCell As Cell
   
3.     Dim oTable As Table
   
4.     Dim end_col, start_r, end_r
   
5.     With ActiveDocument
   
6.         For Each oTable In .Tables
   
7.             For Each oCell In oTable.Range.Cells
   
8.                 end_col = oTable.Columns.Count
   
9.                 If InStr(oCell.Range.Text, "距离") Then
   
10.                     start_r = oCell.RowIndex
    
11.                 End If
    
12.                 If InStr(oCell.Range.Text, "备注信息") Then
    
13.                     end_r = oCell.RowIndex - 1
    
14.                 End If
    
15.             Next
    
16.             For i = start_r To end_r
    
17.                 oTable.Cell(i, end_col - 1).Range.Text = ""
    
18.                 oTable.Cell(i, end_col - 1).Merge mergeto:=oTable.Cell(i, end_col)
    
19.             Next
    
20.         Next
    
21.     End With
    
22.     MsgBox "完成"
    
23. End Sub
    

复制代码

确保表格都是需要合并的，不然会报错，
只能运行一次，不然会报错，
注意备份原始数据