ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 8176|回复: 20

[求助] 一张word格式的试卷,如何将每题后面的答案,解析,考点等剪切到最后。

[复制链接]

TA的精华主题

TA的得分主题

发表于 2015-5-10 10:59 | 显示全部楼层 |阅读模式
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
如题,word里的每道题目后面都有相应的【答案】C【考点】公平正……【解析】……等,都有相应的规律,但是解析那里有多个段落组成。如何将【答案】【考点】【解析】剪切到word的最后面,请论坛内的朋友帮帮忙,谢谢!附件为相应的word。

2014年司法考试真题及解析.rar

210.01 KB, 下载次数: 109

需要分离题目答案的文档

TA的精华主题

TA的得分主题

发表于 2015-5-10 13:00 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
本帖最后由 lq93808-2 于 2015-5-11 21:54 编辑


为什么运行这段代码后,只提取了98或99个答案?求解!
Sub 整理试题()
On Error Resume Next
Documents(1).Activate
ActiveDocument.Content.Find.Execute FindText:="【答案】", replacewith:="@【答案】", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="^p^p", replacewith:="#^p^p", Replace:=wdReplaceAll
c = Documents(1).Range
Set d = CreateObject("scripting.dictionary")
Set regx = CreateObject("vbscript.regexp")
regx.Global = True
regx.Pattern = "(@)([^@]+)(#)"
Set mat = regx.Execute(c)
For Each m In mat
k = k + 1
mm = mm & Chr(13) & k & "." & m
Next
With ActiveDocument
.Content.Find.Execute FindText:="^l", replacewith:="^p", Replace:=wdReplaceAll
.Content.Find.Execute FindText:="^13", replacewith:="^p", Replace:=wdReplaceAll
.Content.Find.Execute FindText:="^pA", replacewith:="A", Replace:=wdReplaceAll
.Content.Find.Execute FindText:="^pB", replacewith:="B", Replace:=wdReplaceAll
.Content.Find.Execute FindText:="^pC", replacewith:="C", Replace:=wdReplaceAll
.Content.Find.Execute FindText:="^pD", replacewith:="D", Replace:=wdReplaceAll
.Paragraphs(1).Range.InsertBefore Text:="1."
.Paragraphs(2).Range.InsertBefore Text:="1."
.Paragraphs(3).Range.InsertBefore Text:="1."
.Paragraphs(4).Range.InsertBefore Text:="1."
End With
Dim i As Paragraph
For Each i In ActiveDocument.Paragraphs
If Not (i.Range Like "[一二三四五六七八九十]、*" & vbCr Or i.Range Like "[一二三四五六七八九十][一二三四五六七八九十]、*" & vbCr Or i.Range Like "[一二三四五六七八九十]十[一二三四五六七八九十]、*" & vbCr Or i.Range Like "[123456789].*" & vbCr Or i.Range Like "[123456789][0123456789].*" & vbCr Or i.Range Like "[123456789][0123456789][0123456789].*" & vbCr) Then
i.Range.Delete
End If
Next
With ActiveDocument
.Content.Find.Execute FindText:="^p^p^p", replacewith:="", Replace:=wdReplaceAll
.Content.Find.Execute FindText:="A.", replacewith:="^pA.", Replace:=wdReplaceAll
.Content.Find.Execute FindText:="B.", replacewith:="^pB.", Replace:=wdReplaceAll
.Content.Find.Execute FindText:="C.", replacewith:="^pC.", Replace:=wdReplaceAll
.Content.Find.Execute FindText:="D.", replacewith:="^pD.", Replace:=wdReplaceAll
.Paragraphs(1).Range.Characters(1).Delete
.Paragraphs(2).Range.Characters(1).Delete
.Paragraphs(3).Range.Characters(1).Delete
.Paragraphs(4).Range.Characters(1).Delete
.Paragraphs(1).Range.Characters(1).Delete
.Paragraphs(2).Range.Characters(1).Delete
.Paragraphs(3).Range.Characters(1).Delete
.Paragraphs(4).Range.Characters(1).Delete
End With
Selection.EndKey unit:=wdStory
Selection = Chr(13) & Chr(13) & Chr(13) & Chr(13)
Selection.EndKey unit:=wdStory
Selection = mm
ActiveDocument.Content.Find.Execute FindText:="#", replacewith:="", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="@", replacewith:="", Replace:=wdReplaceAll
ThisDocument.Saved = True
End Sub

TA的精华主题

TA的得分主题

发表于 2015-5-10 13:07 | 显示全部楼层
请楼主备份原文件后,应用下面的宏(用Word2003打开文档,处理时需要1-2分钟,请耐心等待。。。):
Sub test()
'提取试题(删除答案)
    On Error Resume Next
'创建副本
    ActiveDocument.SaveAs FileName:=ActiveDocument.Path & "\" & Left(ActiveDocument.Name, Len(ActiveDocument.Name) - 4) & "_试题_New" & ".doc"
    With ActiveDocument.Content.Find
        .Execute FindText:="^l", replacewith:="^p", Replace:=wdReplaceAll  '手动换行符=>段落标记(全部替换)
        .Execute FindText:="^13", replacewith:="^p", Replace:=wdReplaceAll '真假回车符=>段落标记(全部替换)
    End With
    With ActiveDocument
        .Paragraphs(1).Range.InsertBefore Text:="一、"
        .Paragraphs(2).Range.InsertBefore Text:="一、"
        .Paragraphs(3).Range.InsertBefore Text:="一、"
        .Paragraphs(4).Range.InsertBefore Text:="一、"
    End With
    ActiveDocument.Content.Find.Execute FindText:="^pA", replacewith:="A", Replace:=wdReplaceAll
    ActiveDocument.Content.Find.Execute FindText:="^pB", replacewith:="B", Replace:=wdReplaceAll
    ActiveDocument.Content.Find.Execute FindText:="^pC", replacewith:="C", Replace:=wdReplaceAll
    ActiveDocument.Content.Find.Execute FindText:="^pD", replacewith:="D", Replace:=wdReplaceAll
    Dim i As Paragraph
    For Each i In ActiveDocument.Paragraphs
        If Not (i.Range Like "[一二三四五六七八九十]、*" & vbCr Or i.Range Like "[一二三四五六七八九十][一二三四五六七八九十]、*" & vbCr Or i.Range Like "[一二三四五六七八九十]十[一二三四五六七八九十]、*" & vbCr Or i.Range Like "[123456789].*" & vbCr Or i.Range Like "[123456789][0123456789].*" & vbCr Or i.Range Like "[123456789][0123456789][0123456789].*" & vbCr) Then
            i.Range.Delete
        End If
    Next
    ActiveDocument.Content.Find.Execute FindText:="A.", replacewith:="^pA.", Replace:=wdReplaceAll
    ActiveDocument.Content.Find.Execute FindText:="B.", replacewith:="^pB.", Replace:=wdReplaceAll
    ActiveDocument.Content.Find.Execute FindText:="C.", replacewith:="^pC.", Replace:=wdReplaceAll
    ActiveDocument.Content.Find.Execute FindText:="D.", replacewith:="^pD.", Replace:=wdReplaceAll
    With ActiveDocument
        .Paragraphs(1).Range.Characters(1).Delete
        .Paragraphs(2).Range.Characters(1).Delete
        .Paragraphs(3).Range.Characters(1).Delete
        .Paragraphs(4).Range.Characters(1).Delete
    End With
    With ActiveDocument
        .Paragraphs(1).Range.Characters(1).Delete
        .Paragraphs(2).Range.Characters(1).Delete
        .Paragraphs(3).Range.Characters(1).Delete
        .Paragraphs(4).Range.Characters(1).Delete
    End With
    Selection.HomeKey Unit:=wdStory
    ActiveWindow.ActivePane.View.Zoom.PageFit = wdPageFitBestFit
    ActiveDocument.Close savechanges:=wdSaveChanges
    MsgBox "处理完毕!(文档已经保存)!!!!!!", vbOKOnly + vbExclamation, "提取试题(删除答案)"
End Sub

TA的精华主题

TA的得分主题

发表于 2015-5-10 22:57 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
本帖最后由 duquancai 于 2015-5-10 23:07 编辑

思路:反向思维,就是:删除题目,剩下的就是你需要的。
          具体操作为:勾选通配符 查找[0-9]{1,}.*[\((]*[)\)]*^13   替换”空“(什么都不要填)。
          但是:”2014年司法考试真题解析试卷一.doc   中的第76道题 最后没有“( )”,所以有问题,其余都没有为题,主要原因是漏写了,详见附件图片:
          当然也可以:勾选通配符 查找[0-9]{1,}.*[\((]*[)\)]*^13   然后剪贴,粘贴到文档的最前面,后面就是你需要的。
IU`}H8JKB@]M`5Q6}ZEG6%M.png

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-5-11 09:35 | 显示全部楼层
duquancai 发表于 2015-5-10 22:57
思路:反向思维,就是:删除题目,剩下的就是你需要的。
          具体操作为:勾选通配符 查找[0-9]{1,} ...

万分感谢你的回答  我去试试  谢谢你

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-5-11 09:43 | 显示全部楼层
duquancai 发表于 2015-5-10 22:57
思路:反向思维,就是:删除题目,剩下的就是你需要的。
          具体操作为:勾选通配符 查找[0-9]{1,} ...

不过为什么会显示这样呢
(O{JFYZWZ)F(_U]}(NQY13B.png

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-5-11 09:44 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
lq93808-2 发表于 2015-5-10 13:00
用正则提取应该可以,只有高手才能做得到.

不懂        

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-5-11 09:45 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
413191246se 发表于 2015-5-10 13:07
请楼主备份原文件后,应用下面的宏(用Word2003打开文档,处理时需要1-2分钟,请耐心等待。。。):
Sub t ...

谢谢你的回复  代码试试

TA的精华主题

TA的得分主题

发表于 2015-5-11 10:37 | 显示全部楼层
本帖最后由 duquancai 于 2015-5-11 16:22 编辑

还是逆向思维:主要分3步完成你想得到的结果
        第一步:通过查找替换把文档中的题干部分和选项部分一次性替换为其它颜色(区别于目标颜色);
                     勾选通配符,查找[0-9]{1,}.*[\((]*[)\)]*^13[A-Z].*^13[A-Z].*^13[A-Z].*^13[A-Z].*^13标注为“红色”(其它颜色也行,区别于“【答案】C【考点】公平正……【解析】……等”的颜色)。
         第二步:利用“选取格式的相似文本”选中标题“一、单项选择题......;二、多项选择题......;三、不定项选择题......"并标注颜色(区别于目标颜色),红色也行,顺便也选中文档最开始部分字符”试 卷 一

提示:本试卷为选择题,由计算机阅读。请将所选答案填涂在答题卡上,勿在卷面上直接作答。“并标注颜色(区别于目标颜色),红色也行。
         第三步:取消通配符,查找”自动颜色“(格式),这时就选中了”【答案】C【考点】公平正……【解析】……等“,然后剪切到word文档的最后面,OK,整个操作就分分钟的事情!
        提醒楼主:我用的是word2010,6楼用的wps,在用查找替换的时候,通配符表达式是否有区别呢?请楼主添加”试卷一第76题的题干尾部“括号!

TA的精华主题

TA的得分主题

发表于 2015-5-14 23:32 | 显示全部楼层
本帖最后由 duquancai 于 2015-5-16 21:58 编辑

第一步:通过查找替换把文档中的题干部分和选项部分一次性替换为其它颜色(区别于目标颜色);
                     勾选通配符,查找[0-9]{1,3}.*D.*^13标注为“红色”(其它颜色也行,区别于“【答案】C【考点】公平正……【解析】……等”的颜色)。
         第二步:利用“选取格式的相似文本”选中标题“一、单项选择题......;二、多项选择题......;三、不定项选择题......"并标注颜色(区别于目标颜色),红色也行,顺便也选中文档最开始部分字符”试 卷 一

提示:本试卷为选择题,由计算机阅读。请将所选答案填涂在答题卡上,勿在卷面上直接作答。“并标注颜色(区别于目标颜色),红色也行。
         第三步:取消通配符,查找”自动颜色“(格式),这时就选中了”【答案】C【考点】公平正……【解析】……等“,然后剪切到word文档的最后面,OK,整个操作就分分钟的事情!
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-27 19:39 , Processed in 0.069734 second(s), 10 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表