如何检查文档中是否有答案及整理答案？

sblisb · 发表于 2015-11-2 15:35

文档是选择题习题，复制来的时候有的有答案有的没有答案，如何用vba检查哪题没有答案后跳转到题目呢？
我查了一下，答案是一个单独的字母如"A"，""B，"C","D"或者为”答案：And“，如果字母后有.号的为选择项的题目待选项
全部都有答案后如何删了题目中的答案，而把答案放在文档尾呢？格式为

答案：

1-5 BDBAC

6-10 ABCAD

新建 Microsoft Word 文档.zip (4.32 KB, 下载次数: 46)

kqbt · 发表于 2015-11-3 16:48

本帖最后由 kqbt 于 2015-11-4 19:40 编辑

先试一下能否将答案整理为统一格式：

Sub 整理答案()
With ActiveDocument.Content.Find
.ClearFormatting
.Replacement.ClearFormatting
.Execute "([!^13：])([A-D]@)([!.]*D.*^13)", , , True, , , , , , "\1\3答案：\2", wdReplaceAll
End With
End Sub

复制代码

sblisb · 发表于 2015-11-3 20:37

kqbt 发表于 2015-11-3 16:48
先试一下能否将答案整理为统一格式：

你的意思是先给答案统一格式，再来查找？
你的代码有用，但是有一种情况不会算是，就是在选择题后的答案，不会整理成“答案：？”的格式
比如下题：
3.第十二届全国人民代表大会第三次会议3月5日上午在人民大会堂开幕。国务院总理李克强向大会作政府工作报告时指出，时代赋予中国发展兴盛的历史机遇。我们要紧密团结在以习近平同志为总书记的党中央周围，高举中国特色社会主义伟大旗帜，凝神聚力，开拓创新，努力完成今年经济社会发展目标任务，为实现( )奋斗目标、建成富强民主文明和谐的社会主义现代化国家、实现中华民族伟大复兴的中国梦作出新的更大贡献。
A.“全面建成小康 B.“两个一百年” C.“中国梦” D.“实现区域协调发展”
B

kqbt · 发表于 2015-11-4 19:41

Sub 整理答案()
With ActiveDocument.Content
.Font.Size = 10.5
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Execute "^b", , , False, , , , , , "^p", wdReplaceAll
.Execute "[^11^13]{1,}", , , True, , , , , , "^p", wdReplaceAll
.Execute "[^13　^32^s^t]@([B-D].)", , True, , , , , , , "^p\1", wdReplaceAll
.Execute "([!:：])([A-D]@)([!.．]*)([0-9]@[.．])", , , True, , , , , , "\1\3答案：\2^p\4", wdReplaceAll
.Execute "[^11^13]{1,}", , , True, , , , , , "^p", wdReplaceAll
End With
End With
End Sub

复制代码

sblisb · 发表于 2015-11-5 23:04

kqbt 发表于 2015-11-4 19:41

谢谢！
上次代码是第3题不能整理，其它可以
这次第3题可以了，可是第5题又不行了
见附件

新建 Microsoft Word 文档.zip (10.33 KB, 下载次数: 9)

kqbt · 发表于 2015-11-6 20:51

sblisb 发表于 2015-11-5 23:04
谢谢！
上次代码是第3题不能整理，其它可以
这次第3题可以了，可是第5题又不行了

如果只有几道题，我觉得没有多大的意义。如果题量较大，最好多上传一些题，以便测试各种情形。
针对楼上提到的第5题无法处理，准确的说应该是最后一道题无法处理……因为所用通配符是通过上一道题的题号与下一道题的题号来进行定位处理的。

sblisb · 发表于 2015-11-6 23:02

kqbt 发表于 2015-11-6 20:51
如果只有几道题，我觉得没有多大的意义。如果题量较大，最好多上传一些题，以便测试各种情形。
针对楼上 ...

谢谢，一个练习都是100题的，所以才想要代码简化工作
这五种把各种写答案的情况都考虑到了，上传太多题目看得眼花呀
最后一题不好处理就手动处理吧，现在整理好了，如何提取答案呢？

kqbt · 发表于 2015-11-7 09:50

本帖最后由 kqbt 于 2015-11-7 11:23 编辑

sblisb 发表于 2015-11-6 23:02
谢谢，一个练习都是100题的，所以才想要代码简化工作
这五种把各种写答案的情况都考虑到了，上传太多题 ...

还是分为两个过程吧：

Sub 整理题号及答案()
Dim wRng As Range, aStr As String
Dim cNum As Integer
Set wRng = ActiveDocument.Content
With wRng
.Font.Size = 10.5
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Execute "^m", , , False, , , , , , "^p", wdReplaceAll
.Execute "^b", , , False, , , , , , "^p", wdReplaceAll
.Execute "[^13　^32^s^t]@([B-D].)", , True, , , , , , , "^p\1", wdReplaceAll
.Execute "([!:：])([A-D]@)([!.]*)([0-9]@.)", , , True, , , , , , "\1\3答案：\2^p\4", wdReplaceAll
.Execute "[^11^13]{1,}", , , True, , , , , , "^p", wdReplaceAll
cNum = 1
Do While .Execute("^13[0-9]@.", , , True)
If wRng <> Chr(13) & cNum & "." Then
wRng.Text = Replace(wRng, Mid(wRng, 2, Len(wRng) - 2), cNum)
End If
cNum = cNum + 1
Loop
wRng.SetRange wRng.End, ActiveDocument.Content.End
If .Execute("[!:：][A-D]@[!.]", , , True, , , True) Then
aStr = Mid(wRng, 2, Len(wRng) - 2)
wRng.Delete
ActiveDocument.Content.InsertAfter "答案：" & aStr
End If
End With
End With
End Sub

复制代码

Sub 提取答案()
Dim wRng As Range, nRng As Range
Dim cNum As Integer, aStr As String
cNum = 1
Set wRng = ActiveDocument.Content
With wRng.Find
.ClearFormatting
.Replacement.ClearFormatting
Do While .Execute(Chr(13) & cNum + 1 & ".", , , False)
wRng.Collapse wdCollapseStart
Set nRng = wRng.Paragraphs(1).Range
If nRng Like "答案[:：][A-D]" & Chr(13) Then
aStr = aStr & cNum & Replace(Right(nRng, 2), Chr(13), "") & Chr(9)
nRng.Delete
Else
aStr = aStr & cNum & "?" & Chr(9)
End If
cNum = cNum + 1
Loop
Set nRng = ActiveDocument.Paragraphs.Last.Range
If nRng Like "答案[:：][A-D]" & Chr(13) Then
aStr = aStr & cNum & Replace(Right(nRng, 2), Chr(13), "")
nRng.Select
nRng.Delete
Else
aStr = aStr & cNum & "?"
End If
ActiveDocument.Content.InsertAfter Chr(13) & "【答案】" & Chr(13) & aStr
End With
End Sub

复制代码

		自动登录	找回密码
密码			免费注册

[求助] 如何检查文档中是否有答案及整理答案？