如何提取答案

zzpsx

如何提取答案-.rar (20.93 KB, 下载次数: 16)

2021-5-13 21:50 上传

点击文件名下载附件

ps:黄色句子末尾的序号就是参考答案的序号

zzpsx

我的土办法是把黄色部分复制到excel，然后用ctrl+e键分离后排序

zzpsx

版主可否将此贴移到vba板块，谢谢。

413191246se

* 楼主，请勾选文字后，执行宏；第二次勾选文字后，按热键 F3 即可！

1. Sub aaaa_zzpsx()
   
2.     KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyF3), KeyCategory:=wdKeyCategoryMacro, Command:="aaaa_zzpsx"
   
3.     Dim r As Range, i As Paragraph, c As Cell, n As Long
   
4.     With Selection
   
5.         If .Type = 1 Then MsgBox "No-Select!", 0 + 16: End
   
6.         If .Text Like vbCr & "*" Then .MoveStart
   
7.         If .Text Like "*" & vbCr & vbCr Then .MoveEnd 1, -1
   
8.         Set r = .Range
   
9.         .InsertAfter Text:=vbCr & .Text
   
10.         For Each i In r.Paragraphs
    
11.             If i.Range Like "*#?" Then i.Range.Characters.Last.Previous.Delete
    
12.         Next
    
13.         Do
    
14.             .MoveStart 4
    
15.         Loop Until .Text Like vbCr & "*"
    
16.         .MoveStart 4
    
17.         .ConvertToTable Separator:=wdSeparateByParagraphs, NumColumns:=1, AutoFitBehavior:=wdAutoFitFixed
    
18.         .InsertColumnsRight
    
19.         For Each c In .Cells
    
20.             n = n + 1
    
21.             c.Range.Text = .Tables(1).Columns(1).Cells(n).Range.Characters.Last.Previous.Text
    
22.         Next
    
23.         .Sort ExcludeHeader:=False, FieldNumber:="列 2", SortFieldType:= _
    
24.             wdSortFieldNumeric, SortOrder:=wdSortOrderAscending, FieldNumber2:="", _
    
25.             SortFieldType2:=wdSortFieldSyllable, SortOrder2:=wdSortOrderAscending, _
    
26.             FieldNumber3:="", SortFieldType3:=wdSortFieldSyllable, SortOrder3:= _
    
27.             wdSortOrderAscending, Separator:=wdSortSeparateByCommas, SortColumn:= _
    
28.             False, CaseSensitive:=False, LanguageID:=wdSimplifiedChinese, _
    
29.             SubFieldNumber:="段落数", SubFieldNumber2:="段落数", SubFieldNumber3:="段落数"
    
30.         .Tables(1).Columns(1).Select
    
31.         .InsertColumns
    
32.         n = 0
    
33.         For Each c In .Cells
    
34.             n = n + 1
    
35.             c.Range.Text = .Tables(1).Columns(2).Cells(n).Range.Characters.First.Text
    
36.         Next
    
37.         .Tables(1).Columns(2).Delete
    
38.         .Tables(1).Columns(2).Delete
    
39.         .Rows.ConvertToText Separator:=wdSeparateByDefaultListSeparator, NestedTables:=True
    
40.         .Text = Replace(.Text, vbCr, "")
    
41.         .InsertBefore Text:="参考答案："
    
42.         .InsertAfter Text:=vbCr
    
43.         .HomeKey 5
    
44.     End With
    
45. End Sub

复制代码

tcdatongye

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

复制代码

413191246se

tcdatongye 老师的代码妙啊！又短！请 楼主 用他的代码吧，将宏设置热键来 F3（或 F8）后应用。

zzpsx

413191246se 发表于 2021-5-16 20:54
tcdatongye 老师的代码妙啊！又短！请 楼主 用他的代码吧，将宏设置热键来 F3（或 F8）后应用。

谢谢两位高手，都是超级厉害的高手，感谢你们的热情帮助。

wdpfox

感谢楼上两位老师热心帮助分享，支持一下！

zzpsx

这个文件提取的答案重复了.rar (23.37 KB, 下载次数: 14)

2021-5-18 20:16 上传

点击文件名下载附件

各位高手，之前代码运行提取的答案是正确的，不过这个文件好像不正确，提取的答案有重复的字母了，不知道为何？

413191246se

* 楼主，tcdatongye 老师的代码，看不懂！（数组+查找替换+循环），请试用我新编的宏：

1. Sub aaaa_zzpsx_2()
   
2. '请将光标放在 A.-E.段落中！不必勾选！
   
3.     Dim r As Range, i As Paragraph, c As Cell, n As Long
   
4.     With Selection
   
5.         Do
   
6.             .Expand 4
   
7.             If .Text Like "A.*#?" Then GoTo sk
   
8.             Do
   
9.                 .MoveStart 4, -1
   
10.             Loop Until .Text Like "A.*"
    
11. sk:
    
12.             If .Text Like "*E.*#?" Then GoTo si
    
13.             Do
    
14.                 .MoveEnd 4
    
15.             Loop Until .Text Like "*E.*"
    
16. si:
    
17.             CommandBars.FindControl(ID:=122).Execute
    
18.             CommandBars.FindControl(ID:=123).Execute
    
19.             Set r = .Range
    
20.             .InsertAfter Text:=vbCr & .Text
    
21.             For Each i In r.Paragraphs
    
22.                 If i.Range Like "*#?" Then i.Range.Characters.Last.Previous.Delete
    
23.             Next
    
24.             Do
    
25.                 .MoveStart 4
    
26.             Loop Until .Text Like vbCr & "*"
    
27.             .MoveStart 4
    
28.             .ConvertToTable Separator:=wdSeparateByParagraphs, NumColumns:=1, AutoFitBehavior:=wdAutoFitFixed
    
29.             .InsertColumnsRight
    
30.             n = 0
    
31.             For Each c In .Cells
    
32.                 n = n + 1
    
33.                 c.Range.Text = .Tables(1).Columns(1).Cells(n).Range.Characters.Last.Previous.Text
    
34.             Next
    
35.             .Sort ExcludeHeader:=False, FieldNumber:="列 2", SortFieldType:= _
    
36.                 wdSortFieldNumeric, SortOrder:=wdSortOrderAscending, FieldNumber2:="", _
    
37.                 SortFieldType2:=wdSortFieldSyllable, SortOrder2:=wdSortOrderAscending, _
    
38.                 FieldNumber3:="", SortFieldType3:=wdSortFieldSyllable, SortOrder3:= _
    
39.                 wdSortOrderAscending, Separator:=wdSortSeparateByCommas, SortColumn:= _
    
40.                 False, CaseSensitive:=False, LanguageID:=wdSimplifiedChinese, _
    
41.                 SubFieldNumber:="段落数", SubFieldNumber2:="段落数", SubFieldNumber3:="段落数"
    
42.             .Tables(1).Columns(1).Select
    
43.             .InsertColumns
    
44.             n = 0
    
45.             For Each c In .Cells
    
46.                 n = n + 1
    
47.                 c.Range.Text = .Tables(1).Columns(2).Cells(n).Range.Characters.First.Text
    
48.             Next
    
49.             .Tables(1).Columns(2).Delete
    
50.             .Tables(1).Columns(2).Delete
    
51.             .Rows.ConvertToText Separator:=wdSeparateByDefaultListSeparator, NestedTables:=True
    
52.             .Text = Replace(.Text, vbCr, "")
    
53.             .InsertBefore Text:="参考答案："
    
54.             .InsertAfter Text:=vbCr
    
55.             .EndKey 5
    
56.             Do
    
57.                 .Move 4
    
58.                 If .Paragraphs(1).Range.End = ActiveDocument.Content.End Then End
    
59.             Loop Until .Paragraphs(1).Range Like "A.*#?"
    
60.             If MsgBox("是否继续?", 4 + 16) = vbNo Then End
    
61.         Loop
    
62.     End With
    
63. End Sub

复制代码