有没有大神教一下小白，用宏编辑将分开的题目与答案对应到一起，变成

kiddopan

有没有大神教一下小白，用宏编辑将分开的题目与答案对应到一起，变成一个答案跟着一个题目这样的形式，跟着多年前的一个帖子琢磨了好久都没弄出来。

413191246se

天呢！我用我的高级联想电脑Geekpro/i7-9700/16G/512G-SSD+1G-HDD/Nvidia GeForce GTX 1066Ti/43寸飞利浦显示器/Windows10-64位家庭和学生版/Office2019家庭版，反复下载并打开楼主的文档2次后，发现，什么文档也没有打开！难道我是《皇帝的新装》里面的皇帝吗？我太笨了，连一个字符都看不到，像根本没有打开文档一样！这是怎么回事？

zhanglei1371

1. Sub 题库答案解析还原()
   
2. Dim pa As Paragraph, arr(), brr(), crr()
   
3. Dim rg As Range, rg1 As Range
   
4.     Selection.HomeKey 6
   
5.     Selection.Find.Execute "([!^13])答案", , , 1, , , , , , "\1", 2
   
6.     ActiveDocument.Range.InsertAfter chr(13) & "123456．"
   
7.     i = 0
   
8.     Selection.HomeKey 6
   
9.     With Selection.Find
   
10.         .Text = "答案"
    
11.         .Replacement.Text = "^&"
    
12.         If .Execute Then
    
13.             mst = Selection.Start
    
14.             Selection.InsertBefore "12345．"
    
15.             mend = Selection.End
    
16.         End If
    
17.     End With
    
18.     Selection.HomeKey 6
    
19.     With Selection.Find
    
20.         .Text = "[0-9]@．"
    
21.         .MatchWildcards = 1
    
22.         Do While .Execute
    
23.             ReDim Preserve arr(i)
    
24.             If .Parent <> "1．" Then
    
25.                 arr(i) = .Parent.Start
    
26.                 i = i + 1
    
27.             End If
    
28.             If InStr(Selection.Paragraphs(1).Range, "答案") Then Exit Do
    
29.         Loop
    
30.     End With
    
31.     Selection.EndKey
    
32.     With Selection.Find
    
33.         j = 0
    
34.         .Text = "[0-9]@．"
    
35.         .MatchWildcards = 1
    
36.         Do While .Execute
    
37.             ReDim Preserve brr(j)
    
38.             If Selection.Previous = Chr(13) Then
    
39.                 brr(j) = .Parent.Start
    
40.                 j = j + 1
    
41.             End If
    
42.         Loop
    
43.     End With
    
44.     For jj = 1 To j - 1
    
45.         ReDim Preserve crr(jj - 1)
    
46.         crr(jj - 1) = ActiveDocument.Range(brr(jj - 1), brr(jj))
    
47.     Next
    
48.     For ij = i To 1 Step -1
    
49.         DoEvents
    
50.         ActiveDocument.Range(arr(ij - 1), arr(ij - 1)).Select
    
51.         Selection.InsertAfter crr(ij - 1)
    
52.     Next
    
53.     Selection.EndKey
    
54.     Selection.Find.Execute "12345．*123456．", , , 1, , , , , , "", 1
    
55.     MsgBox "ok"
    
56. End Sub
    

复制代码

仅对附件文档有效。

wdpfox

附件是打开什么也没有？

                                        莫愁前路无知己，天下谁人不识君！只道是：海内存知己，天涯若比邻！  

cuanju

要用wps打开，再保存为docx格式，用word2016才能打开，挺麻烦的，

wdpfox

没有wps，。……...................请楼主上传个Word版本。学习一下。


                                        莫愁前路无知己，天下谁人不识君！只道是：海内存知己，天涯若比邻！  

kiddopan

不好意思，以为是一篇会沉的帖子，word版本已上传。感谢3楼的大神。