如何提取答案

zzpsx

413191246se 发表于 2021-5-19 02:52
* 楼主，tcdatongye 老师的代码，看不懂！（数组+查找替换+循环），请试用我新编的宏：

感谢高手多次帮助，好像提取的答案还不对，参考答案：ECAAB，有两个a，有重复了。

zzpsx

把参考答案的序号放在前面可否会简单点？.rar (12.01 KB, 下载次数: 2)

2021-5-19 10:35 上传

点击文件名下载附件

wdpfox

适合答案数字在句末。

Sub test()
   
    Selection.StartOf unit:=wdStory
   
    Dim arr(1 To 100)
   
    With Selection.Find
        
        .MatchWildcards = True
        k = "参考答案："
        
        Do
            
            .Text = "<([ABCDEF].[!^13]{1,})"
            
            If .Execute = False Then Exit Do
            
            ss = Left(.Parent, 1)
            
            Selection.Collapse 0
            
            Selection.MoveStartWhile " ", wdBackward
            
            Selection.MoveStartWhile "0123456789", wdBackward
            
            t = Selection.Text * 1
            
            If t = "" Then Exit Sub
            
            Selection.Delete
            
            arr(t) = ss
            
            j = j + 1
            
        Loop
        
        For i = 1 To j
            
            k = k & arr(i)
            
        Next
        
        Selection.InsertBefore vbCrLf & k
        
    End With
   
    Selection.HomeKey wdStory
   
End Sub

413191246se

wdpfox 朋友 都会出代码了！而且还能读懂 tcdatongye 老师的代码！我是否应该称 wdpfox 朋友 为 老师 呢？

cuanju

413191246se 发表于 2021-5-19 17:04
wdpfox 朋友 都会出代码了！而且还能读懂 tcdatongye 老师的代码！我是否应该称 wdpfox 朋友 为 老师 呢？

wdpfox朋友是一位大师

wdpfox

413191246se 发表于 2021-5-19 17:04
wdpfox 朋友 都会出代码了！而且还能读懂 tcdatongye 老师的代码！我是否应该称 wdpfox 朋友 为 老师 呢？

老师客气了，我只是学会变通一下。是借论坛众多老师的“肩膀”学习的。我要多谢包括您在内的老师们。再说一声，谢谢。

wdpfox

cuanju 发表于 2021-5-19 17:19
wdpfox朋友是一位大师

cuanju老师知道我的“斤两”……

413191246se

cuanju 老师 也 知道我的“斤两”……（我有不少宏是在录制宏的基础上修改而来。）

413191246se

* 昨天下午重写的全自动排序宏，适用于数字在后的情况（其实，楼主，你可以按 Alt+Shift+Up/Down来快速调整段落上下移动的）。请自行将“Answer:”改为“参考答案：”。

1. Sub aaaa_Sort()
   
2.     Dim i As Paragraph, j&, s$, t$
   
3.     With Selection
   
4.         .WholeStory
   
5.         CommandBars.FindControl(ID:=122).Execute
   
6.         CommandBars.FindControl(ID:=123).Execute
   
7.         .HomeKey 6
   
8.         Do
   
9.             Do
   
10.                 .Move 4
    
11.                 If .Paragraphs(1).Range.End = ActiveDocument.Content.End Then End
    
12.             Loop Until .Paragraphs(1).Range Like "A.*#?"
    
13.             Do
    
14.                 .MoveEnd 4
    
15.             Loop Until .Text Like "*E.*#?"
    
16.             s = ""
    
17.             For Each i In .Paragraphs
    
18.                 If i.Range Like "[A-E].*#?" Then
    
19.                     s = s & i.Range.Characters.Last.Previous.Text & i.Range.Characters.First.Text
    
20.                     i.Range.Characters.Last.Previous.Delete
    
21.                 Else
    
22.                     .Font.Color = wdColorRed
    
23.                     MsgBox "Error!", 0 + 16: End
    
24.                 End If
    
25.             Next
    
26.             .InsertAfter Text:=vbCr & s & vbCr
    
27.             .Paragraphs.Last.Range.Select
    
28.             t = ""
    
29.             j = 0
    
30.             Do
    
31.                 j = j + 1
    
32.                 t = t & .Characters(InStr(s, j) + 1)
    
33.             Loop Until j = 5
    
34.             .Text = "Answer:" & t & vbCr
    
35.             .EndKey 5
    
36.         Loop
    
37.     End With
    
38. End Sub

复制代码

cuanju

wdpfox 发表于 2021-5-19 19:07
cuanju老师知道我的“斤两”……

我喜欢借鉴论坛的代码^_^，尤其是413191246se、wdpfox两位老师经常给我启发共同学习进步