根据答案标记选项

常扬帆 · 发表于 2022-10-1 09:34

根据答案，用其他颜色标记出选项整行，序号后标点符号不一致。请您赐教，万分感谢！

413191246se · 发表于 2022-10-1 20:29

Sub a1001_AnswerRed()
'根据答案标记选项行
Dim r As Range, s As Range, t As Range, i As Paragraph, j&, k&
With ActiveDocument
With .Content.Font
.NameFarEast = "宋体"
.NameAscii = "Times New Roman"
End With
For Each i In .Paragraphs
With i.Range
If .Text Like "#*" Then
With .Font
.NameFarEast = "楷体"
.NameAscii = "Times New Roman"
.Bold = True
End With
.InsertParagraphBefore
End If
End With
Next
With .Content.Find
.Execute "(答案):", , , 1, , , , , , "\1：", 2
.Execute "([A-D])[.、]", , , 1, , , , , , "\1．", 2
.Execute "(^13[0-9]{1,})[.、]", , , 1, , , , , , "\1．", 2
End With
Set r = .Content
End With
With r.Find
.ClearFormatting
.Text = "答案："
.Forward = True
.MatchWildcards = True
Do While .Execute
With .Parent
.Next.Select
With Selection
.Extend vbCr
.MoveEnd 1, -1
Set s = .Range
.MoveStart 4, -5
.MoveEnd 4, -1
Set t = .Range
k = Len(s)
For j = k To 1 Step -1
For Each i In t.Paragraphs
With i.Range
If .Text Like s.Characters(j).Text & "*" Then
With .Font
.Bold = True
.ColorIndex = wdRed
.Underline = wdUnderlineSingle
End With
Exit For
End If
End With
Next
Next
End With
End With
Loop
End With
Selection.HomeKey 6
End Sub

复制代码

常扬帆 · 发表于 2022-10-2 07:29

413191246se 发表于 2022-10-1 20:29

不但双重(颜色和下划线)标注了选项，还楷体标注了题干。衷心感谢您！

蜀中草莽 · 发表于 2022-10-2 08:40

413191246se 发表于 2022-10-1 20:29

学到了，还是VBA厉害，单选用通配符能标出来，多选只能标出第一个，也许是方法没对

常扬帆 · 发表于 2022-10-8 09:07

413191246se 发表于 2022-10-1 20:29

您好！我想问一下，这个还能优化速度吗？今天一个大文件近千页，造成假死，只好结束进程。如果取消空行、取消下划线、取消标题加粗字体，速度能否快点？因为我是代码白痴，看你还能优化些什么。辛苦您！衷心感谢！

413191246se · 发表于 2022-10-8 12:33

扬帆朋友，你好！——请打开文档后，点击“视图”，“页宽”，再观察状态栏上文档的总字数已经计算出来后，再执行宏（另外，请将代码拷贝到 Word 2019 的新建文档后，全选，剪切，关闭空白文档后，再将代码粘贴到 VBE 中；否则，代码中的汉字可能要变成乱码，切记！）。这回，优化过了，你先试试小文档，然后再正式试验大文档（我建议，大文档应该耐心等待一下，5-10 分钟内不要做任何动作），并请事先做好文档的备份。

Sub a1008_Option_Red_by_Answer()
'根据答案标记选项行
Dim doc As Document, s As Range, t As Range, i As Paragraph, j&, k&, l!
l = Timer
Set doc = ActiveDocument
With doc
With .Content.Find
.Execute "(答案):", , , 1, , , , , , "\1：", 2
.Execute "(^13[0-9]{1,}[、.．])", , , 1, , , , , , "^p\1", 2
End With
With .Content.Find
.ClearFormatting
.Text = "答案："
.Forward = True
.MatchWildcards = True
Do While .Execute
With .Parent
Set s = doc.Range(Start:=.End, End:=.Paragraphs(1).Range.End - 1)
k = Len(s)
Set t = .Previous(4, 1)
t.MoveStart 4, -3
For Each i In t.Paragraphs
With i.Range
For j = 1 To k
If .Text Like s.Characters(j).Text & "*" Then
.Font.ColorIndex = wdRed
.Underline = wdUnderlineSingle
Exit For
End If
Next
End With
Next
End With
Loop
End With
End With
MsgBox "处理完毕！用时 " & Timer - l & " 秒！", 0 + 48
End Sub

复制代码

常扬帆 · 发表于 2022-10-8 21:35

413191246se 发表于 2022-10-8 12:33
扬帆朋友，你好！——请打开文档后，点击“视图”，“页宽”，再观察状态栏上文档的总字数已经计算出来后 ...

您好！三百页的标记没问题，500页的崩，另外，下面A、正确，B、错误的这种类型，由于我附件忘了这种类型，结果没标记。辛苦你啦！下面这种类型能否能够加进去？谢谢！再次感谢！
1.驾驶机动车在路口直行遇到这种信号灯应该怎样行驶？
A、不得越过停止线
B、加速直行通过
C、左转弯行驶
D、进入路口等待
答案：A

2.驾驶机动车行驶到这个位置时，如果车前轮已越过停止线可以继续通过。
A、正确
B、错误
答案：错

3.驾驶机动车在这种信号灯亮的路口，可以右转弯。
A、正确
B、错误
答案：对

4.驾驶机动车在路口遇到这种信号灯禁止通行。
A、正确
B、错误
答案：错

wdpfox · 发表于 2022-10-9 07:21

常扬帆发表于 2022-10-8 21:35
您好！三百页的标记没问题，500页的崩，另外，下面A、正确，B、错误的这种类型，由于我附件忘了这种类型 ...

希望楼主分享一下，最近要考驾照，谢了

常扬帆 · 发表于 2022-10-9 07:51

wdpfox 发表于 2022-10-9 07:21
希望楼主分享一下，最近要考驾照，谢了

您好！这些题目，网上搜“元贝驾考”就有，光有题目不行，关键是要学习和总结规律，否则光科一就有2244道题，够您折腾的。

wdpfox · 发表于 2022-10-9 08:12

好的，我搜索一下看看。

We meet by chance like patches of drifting duckweed,
May everything be fine with you everyday !
（你我萍水相逢，愿君一切安好！）

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

[求助] 根据答案标记选项

评分