|
[广告] 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
|
|