如何提取答案

tcdatongye

zzpsx 发表于 2021-5-19 10:10
感谢高手多次帮助，好像提取的答案还不对，参考答案：ECAAB，有两个a，有重复了。

因不知你整个文档是什么情况。该例仅适用于每题有五个答案情况。

1. Sub 替换()
   
2. With ThisDocument.Content.Find
   
3.   .MatchWildcards = True
   
4.   .Text = "([A-E].*)[ ]{1,}(^13)"
   
5.   .Replacement.Text = "\1\2"
   
6.   .Execute Replace:=wdReplaceAll
   
7. End With
   
8. Selection.StartOf unit:=wdStory
   
9. arr = Array("A", "B", "C", "D", "E")
   
10. Do
    
11. With Selection.Find
    
12.   .MatchWildcards = True
    
13.   k = "参考答案："
    
14.   For i = 0 To 4
    
15.     .Text = "(" & arr(i) & ".*)[1-9](^13)"
    
16.     If .Execute = False Then Exit Do
    
17.       ss = Left(Right(.Parent, 2), 1)
    
18.       k = k & arr(ss - 1)
    
19.       .Replacement.Text = "\1\2"
    
20.       .Execute Replace:=wdReplaceOne
    
21.       .Parent.Move
    
22.   Next i
    
23.   Selection.InsertBefore vbCrLf & k
    
24. End With
    
25. Loop
    
26. End Sub

复制代码

413191246se

cuanju 老师，好久不见！我对老师的功夫是佩服得五体投地！请注意休息。
老师 会写《循环遍历文件夹及子文件夹》的代码，我却不会，我只会录制宏，老师的功夫太高了！

zzpsx

413191246se 发表于 2021-5-20 17:00
cuanju 老师，好久不见！我对老师的功夫是佩服得五体投地！请注意休息。
老师 会写《循环遍历文件夹及子文 ...

各位大神都要注意及时休息，同时让电脑也休息一下。

Jason_WangSS

1. Sub 提取答案()
   
2.     Dim wdoc As Document
   
3.     Dim Ans(1 To 10)
   
4.     Dim i, Str1, Str2, AnsNo, m, n
   
5.     Set wdoc = ActiveDocument
   
6.     wdoc.Range.Find.Execute _
   
7.         findtext:="^32{1,}^13", _
   
8.         MatchWildcards:=True, _
   
9.         replacewith:="^13", _
   
10.         Replace:=wdReplaceAll
    
11.    
    
12.     With wdoc.Paragraphs
    
13.         For i = .Count To 1 Step -1
    
14.             With wdoc.Paragraphs(i)
    
15.                 Str1 = .Range.Text
    
16.                 '                If InStr(.Range.Text, "参考答案") Then
    
17.                 '                    AnsNo = i
    
18.                 '                End If
    
19.                 If Str1 Like "[A-E].*" Then
    
20.                     m = .Range.Characters.Count
    
21.                     n = .Range.Characters(m - 1)
    
22.                     Ans(n) = Left(Str1, 1)
    
23.                     If Ans(n) = "E" Then
    
24.                         AnsNo = i + 1
    
25.                     End If
    
26.                     If Ans(n) = "A" Then
    
27.                         Str2 = Join(Ans, "")
    
28.                         wdoc.Paragraphs(AnsNo).Range.Text = "参考答案：" & Str2 & Chr(13)
    
29.                         Erase Ans
    
30.                         AnsNo = 0
    
31.                     End If
    
32.                 End If
    
33.             End With
    
34.         Next
    
35.         Selection.HomeKey
    
36.         wdoc.Range.Find.Execute _
    
37.             findtext:="([.\!])[1-9]^13", _
    
38.             MatchWildcards:=True, _
    
39.             replacewith:="\1^13", _
    
40.             Replace:=wdReplaceAll
    
41.     End With
    
42. End Sub

复制代码