|
- Sub test()
- Dim r%, i%
- Dim arr(), brr
- Dim mydoc As Document
- Dim flg(1 To 3) As Boolean
- Dim reg(1 To 4) As New RegExp
- With reg(1)
- .Global = False
- .Pattern = "^([一二三四五六七八九]、)(选择题|非选择题).*"
- End With
- With reg(2)
- .Global = False
- .Pattern = "^(\d+\.)"
- End With
- With reg(3)
- .Global = False
- .Pattern = "^【答案】(.*)"
- End With
- With reg(4)
- .Global = False
- .Pattern = "^(【详解】|【分析】).*"
- End With
- With ThisDocument
- ReDim arr(1 To .Paragraphs.Count, 1 To 1)
- m = 0
- flg2 = False
- For i = 1 To .Paragraphs.Count
- ss = .Paragraphs(i).Range.Text
- If reg(1).test(ss) Then
- Set mh = reg(1).Execute(ss)
- m = m + 1
- arr(m, 1) = ss
- flg(1) = True
- lx = mh(0).SubMatches(1)
- ElseIf reg(2).test(ss) Then
- If flg(1) = True Then
- Set mh = reg(2).Execute(ss)
- m = m + 1
- arr(m, 1) = mh(0).SubMatches(0)
- flg(2) = True
- End If
- ElseIf reg(3).test(ss) Then
- Set mh = reg(3).Execute(ss)
- arr(m, 1) = arr(m, 1) & mh(0).SubMatches(0)
- flg(3) = True
- ElseIf reg(4).test(ss) Then
- flg(3) = False
- Else
- If flg(3) = True Then
- m = m + 1
- arr(m, 1) = ss
- End If
- End If
- Next
- End With
- Set mydoc = Documents.Add
- mydoc.Select
- With mydoc
- For i = 1 To m
- If Len(arr(i, 1)) <> 0 Then
- Selection.TypeText Text:=arr(i, 1)
- End If
- Next
- .SaveAs2 FileName:=ThisDocument.Path & "" & "答案"
- .Close False
- End With
- MsgBox "答案生成完毕,保存在当前文件夹下!"
- End Sub
复制代码 |
评分
-
1
查看全部评分
-
|