WORD中的人名和台词批量转入EXCEL

ning1119

各位大大：
     你们好，有个问题求助。
     剧本中人名用(皇上）这种括号格式， 台词用“巴拉巴拉” 这种引号格式
     想要把剧本里所有的名字和台词提取到excel，分别为两列，人名和台词。
     求助各位大神！感谢！！！
     

Word和excel.rar (16.09 KB, 下载次数: 12)

2020-7-31 18:33 上传

点击文件名下载附件
原文件

413191246se

楼主，请打开 Word 文档，执行下面的宏，然后，用鼠标勾选表格内的所有文字，复制粘贴到 Excel 即可：

1. Sub test台词()
   
2.     With ActiveDocument.Content.Find
   
3.         .Execute "[^13^11]", , , 1, , , , , , "^p", 2
   
4.         .Execute "\)", , , 1, , , , , , "）", 2
   
5.         .Execute "\(", , , 1, , , , , , "（", 2
   
6.     End With
   
7.     With Selection
   
8.         .WholeStory
   
9.         CommandBars.FindControl(ID:=122).Execute
   
10.         .ClearFormatting
    
11.     End With
    
12.     Dim i As Paragraph
    
13.     For Each i In ActiveDocument.Paragraphs
    
14.         If i.Range.Text = vbCr Then i.Range.Delete: GoTo sk
    
15.         If i.Range Like "[!（]*" Then i.Range.Delete: GoTo sk
    
16.         If i.Range Like "*）*" Then
    
17.             i.Range.Characters(InStr(i.Range, "）")).InsertAfter Text:=vbTab
    
18.         End If
    
19. sk:
    
20.     Next
    
21. '''
    
22.     With Selection
    
23.         .WholeStory
    
24.         .ConvertToTable Separator:=wdSeparateByTabs, NumColumns:=2, AutoFitBehavior:=wdAutoFitFixed
    
25.         .Tables(1).Style = "网格型"
    
26.         .HomeKey Unit:=wdStory
    
27.     End With
    
28.     If MsgBox("是否删除括号和双引号？", 4 + 16) = vbYes Then
    
29.         With ActiveDocument.Content.Find
    
30.             .Execute "[（）]", , , 1, , , , , , "", 2
    
31.             .Execute "[“”]", , , 1, , , , , , "", 2
    
32.         End With
    
33.     End If
    
34. End Sub

复制代码

ning1119

413191246se 发表于 2020-7-31 21:59
楼主，请打开 Word 文档，执行下面的宏，然后，用鼠标勾选表格内的所有文字，复制粘贴到 Excel 即可：

谢谢大神！！！