[求助]：2000行的EXCEL表格转换成多个15行一个的WORD单元表,我该怎么办?

残月寒星

各位高人,我有个2000行的EXCEL表格想要转换成多个15行一个的WORD单元表,有什么简单一些的办法吗？?多谢了!

efan2000

Excel：菜单工具-宏-Visual Basic编辑器，粘贴代码到ThisWorkbook中。
Visual Basic编辑器：菜单工具-引用，引用Microsoft Word 9.0 Object Library。

2. 
   
3.   [FONT=courier new]
   
4. Sub test()
   
5.     On Error Resume Next
   
6.     ' 启动Word
   
7.     Dim wd As Word.Application
   
8.     Set wd = GetObject(, "Word.Application")
   
9.     If Err Then
   
10.         Err.Clear
    
11.         Set wd = CreateObject("Word.Application")
    
12.         If Err Then
    
13.             MsgBox "无法启动Word! "
    
14.             Exit Sub
    
15.         End If
    
16.     End If
    
17.     wd.Visible = True
    
18.    
    
19.     On Error GoTo ErrTrap
    
20.     Dim t As Table
    
21.     Dim i As Integer
    
22.     Dim j As Integer
    
23.     For i = 1 To ActiveSheet.UsedRange.Rows.Count 'Excel中所使用的行。
    
24.         If (i - 1) Mod 15 = 0 Then
    
25.             ' 增加一段落，避免所有的表连结在一起
    
26.             wd.ActiveDocument.Paragraphs.Add
    
27.             ' 选定最后一个段落
    
28.             wd.ActiveDocument.Paragraphs.Last.Range.Select
    
29.             ' 创建一个15行的表格，列数为Excel中所使用的列。
    
30.             Set t = wd.ActiveDocument.Tables.Add(wd.Selection.Range, 15, ActiveSheet.UsedRange.Columns.Count)
    
31.         End If
    
32.         For j = 1 To ActiveSheet.UsedRange.Columns.Count 'Excel中所使用的列。
    
33.             If i Mod 15 = 0 Then '处理每第15行的情况
    
34.                 t.Cell(15, j).Range.Text = ActiveSheet.Cells(i, j)
    
35.             Else '处理其它行的情况
    
36.                 t.Cell(i Mod 15, j).Range.Text = ActiveSheet.Cells(i, j)
    
37.             End If
    
38.         Next
    
39.     Next
    
40.     Exit Sub
    
41.    
    
42. ErrTrap:
    
43.     On Error GoTo 0
    
44. End Sub
    
45.   [/FONT]
    

<br />   [FONT=courier new]<br /> Sub test()<br />     On Error Resume Next<br />     ' 启动Word<br />     Dim wd As Word.Application<br />     Set wd = GetObject(, "Word.Application")<br />     If Err Then<br />         Err.Clear<br />         Set wd = CreateObject("Word.Application")<br />         If Err Then<br />             MsgBox "无法启动Word! "<br />             Exit Sub<br />         End If<br />     End If<br />     wd.Visible = True<br />     <br />     On Error GoTo ErrTrap<br />     Dim t As Table<br />     Dim i As Integer<br />     Dim j As Integer<br />     For i = 1 To ActiveSheet.UsedRange.Rows.Count 'Excel中所使用的行。<br />         If (i - 1) Mod 15 = 0 Then<br />             ' 增加一段落，避免所有的表连结在一起<br />             wd.ActiveDocument.Paragraphs.Add<br />             ' 选定最后一个段落<br />             wd.ActiveDocument.Paragraphs.Last.Range.Select<br />             ' 创建一个15行的表格，列数为Excel中所使用的列。<br />             Set t = wd.ActiveDocument.Tables.Add(wd.Selection.Range, 15, ActiveSheet.UsedRange.Columns.Count)<br />         End If<br />         For j = 1 To ActiveSheet.UsedRange.Columns.Count 'Excel中所使用的列。<br />             If i Mod 15 = 0 Then '处理每第15行的情况<br />                 t.Cell(15, j).Range.Text = ActiveSheet.Cells(i, j)<br />             Else '处理其它行的情况<br />                 t.Cell(i Mod 15, j).Range.Text = ActiveSheet.Cells(i, j)<br />             End If<br />         Next<br />     Next<br />     Exit Sub<br />     <br /> ErrTrap:<br />     On Error GoTo 0<br /> End Sub<br />   [/FONT]<br />

pzzjx

可以用word的邮件合并功能，不用编程的~~~~~~~