把一个word里800多个人的成绩批量转化为Excel格式

kaug0178

扫描的，得到word文件，横版如下，800多人

准考证号：9834759437     考生号：162340101       姓名：李二    总分318               准考证号：9834759437     考生号：162340102   姓名：张三    总分438

市级评价科目  语文：65  数学：61   外语：47（含听力 12） 理化：27  政史：63  //  市级评价科目  语文：85  数学：71   外语：87（含听力 13） 理化：56  政史：79

准考证号：9834759437     考生号：162340103       姓名：李二    总分318               准考证号：9834759437     考生号：162340104  姓名：张三    总分438

市级评价科目  语文：65  数学：61   外语：47（含听力 12） 理化：27  政史：63  //  市级评价科目  语文：85  数学：71   外语：87（含听力 13） 理化：56  政史：79

请大神们帮忙，怎么自动成EXcel,以考生号为标准

考号	语文	数学	外语	理化	政史
162340101	65	61	47	27	63
162340102
162340103
162340104

suse360

Mark 一下，这个问题坐等高人出手

jiminyanyan

WORD是扫描的，搞不定了。。。

小花鹿

还是传个真实的附件吧，模拟的附件容易出问题..........................................................

duquancai

请下载附件，打开Word文件，点击按钮

413191246se

楼主，duquancai（段全才）朋友出手了，我本不该出手，他是高手！但我也费心编了一个宏，请楼主一试：（请将此宏复制一下，然后在 Word 2003 中，按 Alt+F11 打开 VBE 编程环境，再按 Ctrl+End 将光标移到所有编码末尾，粘贴代码后关闭 VBE，然后打开楼主的文档（请注意备份），按 Alt+F8 打开宏列表，找到本宏名 test，然后按“运行”按钮即可，请注意提示！处理完毕注意抽查！）

1. Sub test()
   
2. 
   
3.     If MsgBox("请确认你的 Word 2003 文档中，头几个字符就是<准考证号……>，否则会出错！处理完毕后请自行抽查！" & vbCr & "是否继续？", vbYesNo + vbCritical) = vbNo Then End
   
4. 
   
5. 'Sub 删除手动换行符和假段落标记()
   
6.     ActiveDocument.Content.Find.Execute findtext:="^l", replacewith:="^p", Replace:=wdReplaceAll
   
7.     ActiveDocument.Content.Find.Execute findtext:="^13", replacewith:="^p", Replace:=wdReplaceAll
   
8. 
   
9. 'Sub 删除空行()
   
10.     Dim i As Paragraph
    
11.     For Each i In ActiveDocument.Paragraphs
    
12.         If Len(i.Range) = 1 Then i.Range.Delete
    
13.     Next
    
14. 
    
15. '替换
    
16.     ActiveDocument.Content.Find.Execute findtext:="含听力 ", replacewith:="含听力", Replace:=wdReplaceAll
    
17.     ActiveDocument.Content.Find.Execute findtext:="^p市级评价科目", replacewith:=" 市级评价科目", Replace:=wdReplaceAll
    
18.     ActiveDocument.Content.Find.Execute findtext:=":", replacewith:="：", Replace:=wdReplaceAll
    
19. 
    
20. '循环遍历每个段落
    
21.     Selection.HomeKey Unit:=wdStory
    
22.     For Each i In ActiveDocument.Paragraphs
    
23.         Selection.Find.ClearFormatting
    
24.         Do While Selection.Find.Execute(findtext:="  准考证号", Forward:=True)
    
25.             Do
    
26.                 Selection.MoveEnd Unit:=wdCharacter, Count:=1
    
27.             Loop Until Selection Like "*市级"
    
28.             Exit Do
    
29.         Loop
    
30.         Selection.MoveEnd Unit:=wdCharacter, Count:=-2
    
31.         Selection.Cut
    
32.         Selection.Find.Execute findtext:="//", Forward:=True
    
33.         Selection.Paste
    
34.         i.Range.Characters.First.Copy
    
35.     Next
    
36. 
    
37. '替换
    
38.     ActiveDocument.Content.Find.Execute findtext:="//", replacewith:="", Replace:=wdReplaceAll
    
39.     ActiveDocument.Content.Find.Execute findtext:="市级评价科目", replacewith:="", Replace:=wdReplaceAll
    
40.     ActiveDocument.Content.Find.Execute findtext:=" 准考证号", replacewith:="^p准考证号", Replace:=wdReplaceAll
    
41. 
    
42. 'Sub 删除段落首尾空格()--'全选/居中/两端对齐
    
43.     Selection.WholeStory
    
44.     CommandBars.FindControl(ID:=122).Execute
    
45.     CommandBars.FindControl(ID:=123).Execute
    
46. 
    
47. '套进表格（以空格为界）
    
48.     Selection.WholeStory
    
49.     Selection.ConvertToTable Separator:=4, NumColumns:=10, NumRows:=12, _
    
50.         AutoFitBehavior:=wdAutoFitFixed
    
51.     With Selection.Tables(1)
    
52.         If .Style <> "网格型" Then
    
53.             .Style = "网格型"
    
54.         End If
    
55.         .ApplyStyleHeadingRows = True
    
56.         .ApplyStyleLastRow = True
    
57.         .ApplyStyleFirstColumn = True
    
58.         .ApplyStyleLastColumn = True
    
59.     End With
    
60. 
    
61. '替换
    
62.     ActiveDocument.Content.Find.Execute findtext:="准考证号：", replacewith:="", Replace:=wdReplaceAll
    
63.     ActiveDocument.Content.Find.Execute findtext:="考生号：", replacewith:="", Replace:=wdReplaceAll
    
64.     ActiveDocument.Content.Find.Execute findtext:="姓名：", replacewith:="", Replace:=wdReplaceAll
    
65.     ActiveDocument.Content.Find.Execute findtext:="总分", replacewith:="", Replace:=wdReplaceAll
    
66.     ActiveDocument.Content.Find.Execute findtext:="语文：", replacewith:="", Replace:=wdReplaceAll
    
67.     ActiveDocument.Content.Find.Execute findtext:="数学：", replacewith:="", Replace:=wdReplaceAll
    
68.     ActiveDocument.Content.Find.Execute findtext:="外语：", replacewith:="", Replace:=wdReplaceAll
    
69.     ActiveDocument.Content.Find.Execute findtext:="理化：", replacewith:="", Replace:=wdReplaceAll
    
70.     ActiveDocument.Content.Find.Execute findtext:="政史：", replacewith:="", Replace:=wdReplaceAll
    
71. '
    
72.     Selection.InsertRowsAbove 1
    
73.     Selection.TypeText Text:="准考证号"
    
74.     Selection.MoveRight Unit:=wdCell
    
75.     Selection.TypeText Text:="考生号"
    
76.     Selection.MoveRight Unit:=wdCell
    
77.     Selection.TypeText Text:="姓名"
    
78.     Selection.MoveRight Unit:=wdCell
    
79.     Selection.TypeText Text:="总分"
    
80.     Selection.MoveRight Unit:=wdCell
    
81.     Selection.TypeText Text:="语文"
    
82.     Selection.MoveRight Unit:=wdCell
    
83.     Selection.TypeText Text:="数学"
    
84.     Selection.MoveRight Unit:=wdCell
    
85.     Selection.TypeText Text:="外语"
    
86.     Selection.MoveRight Unit:=wdCell
    
87.     Selection.TypeText Text:="理化"
    
88.     Selection.MoveRight Unit:=wdCell
    
89.     Selection.TypeText Text:="政史"
    
90.     Selection.MoveRight Unit:=wdCell
    
91.     Selection.TypeText Text:="此列删除"
    
92. 
    
93.     Selection.Tables(1).Select
    
94.     MsgBox "处理完毕！！！！！！" & vbCr & "请手工剪切到 Excel 中，并删除最后一列！", vbOKOnly + vbExclamation
    
95. 
    
96. End Sub

复制代码

kaug0178

413191246se 发表于 2016-9-6 23:56
楼主，duquancai（段全才）朋友出手了，我本不该出手，他是高手！但我也费心编了一个宏，请楼主一试：（请 ...

一大早就来看看，感谢你，上午处理不了，等等

kaug0178

duquancai 发表于 2016-9-6 23:23
请下载附件，打开Word文件，点击按钮

不管咋样都谢谢啦，我上午没时间。等弄好了告诉各位

jiminyanyan

作个记号，学习一下。

kaug0178

duquancai 发表于 2016-9-6 23:23
请下载附件，打开Word文件，点击按钮

神啊，我用的是word2003,说安装时候不支持宏，，打开时候，按钮是个图片，我无语了