关于很多表格转文本VBA求助

遥控器78

文件中有很多表格，都是5列，行数不固定，每个表格之间有文字。

我主要想解决表格的问题，目前我的方法是：

先用通配符查找替换把两个字的名字中间加一个全角空格，然后把表格转换成文本，再把名字之间的制表符和每行末尾的段落标记替换成一个全角空格和一个半角空格（两个字的名字中间是一个全角空格，名字与名字之间是一个全角空格加一个半角空格）。

每行10个名字，如果可以把5列表格转换成10列表格也可以。

有没有大神帮忙写个VBA，感谢！

413191246se

1. Sub aaaa表格转文本()
   
2.     Dim t As Table, c As Cell
   
3.     For Each t In ActiveDocument.Tables
   
4.         With t.Range
   
5.             For Each c In .Cells
   
6.                 With c.Range
   
7.                     If Len(.Text) = 4 Then .Characters(1).InsertAfter Text:="　"
   
8.                 End With
   
9.             Next
   
10.             .Rows.ConvertToText Separator:=wdSeparateByTabs, NestedTables:=True
    
11.             .Find.Execute "^p", , , 0, , , , , , "^t", 2
    
12.             .ConvertToTable Separator:=wdSeparateByTabs, NumColumns:=10, AutoFitBehavior:=wdAutoFitFixed
    
13.             .Rows.ConvertToText Separator:=wdSeparateByTabs, NestedTables:=True
    
14.             .Find.Execute "^t", , , 0, , , , , , "　 ", 2
    
15.             .Select
    
16.             CommandBars.FindControl(ID:=122).Execute
    
17.             CommandBars.FindControl(ID:=123).Execute
    
18.             Do While .Text Like "*" & vbCr & vbCr
    
19.                 .Characters.Last.Delete
    
20.             Loop
    
21.             If .Text Like "*以下空白?" Then .Find.Execute "(　)( )(以下空白)", , , 1, , , , , , "\1（\3）", 2
    
22.         End With
    
23.         With Selection
    
24.             .MoveStart 4, -2
    
25.             With .Font
    
26.                 .Name = "宋体"
    
27.                 .Size = 10
    
28.             End With
    
29.             .Range.Find.Execute ":", , , 0, , , , , , "：", 2
    
30.             .Characters(1).Select
    
31.             .Extend "："
    
32.             .Font.Name = "黑体"
    
33.             .Move 4
    
34.             .Extend "："
    
35.             .Font.Name = "黑体"
    
36.             With .Paragraphs(1).Range
    
37.                 If .Text Like "*：???" Then .Characters.Last.Previous.InsertBefore Text:="　"
    
38.             End With
    
39.         End With
    
40.     Next
    
41.     Selection.HomeKey 6
    
42.     ActiveWindow.ActivePane.View.ShowAll = Not ActiveWindow.ActivePane.View.ShowAll
    
43. End Sub

复制代码

遥控器78

413191246se 发表于 2021-10-8 00:41

太厉害了 ，感谢，感谢！工作量一下减少很多。