关于考试题库重组的题号问题

douzi198634

由于要组织考试，需要将题库选择题分成三组，判断题分成三组。我将word内容导入excle已经分好组了，然后把题目粘贴过来之后，是按原来的题目序号走的，因题目较多，如果手动调整序号，会比较慢，不知道大神有没有更加快捷的办法。由于题目带选择项，在excle里面做分列 重新排序，会影响ABCD选项。
第一组的题目序号1/4/7/10/13、、、、、、

凌空一羽

Sub lkyy()
Dim doc As Document, Mp$, dp As Document
Set doc = ActiveDocument
Mp = doc.Path & "\抽取内容.docx"
Application.Visible = True
Set dp = Word.Documents.Open(Mp)
On Error Resume Next
For i = 1 To 631 Step 3   '将i=1 里 1改为2就是第2套，改为3，就是第3套
    doc.Activate
    t1 = i & "、"
    t2 = i + 1 & "、"
    s1 = 0
    s2 = 0
    Selection.HomeKey unit:=wdStory
    With Selection.Find
        .ClearFormatting
        .Text = t1
        .Execute
    End With
    s1 = Selection.Range.Start
    Selection.HomeKey unit:=wdStory
    With Selection.Find
        .ClearFormatting
        .Text = t2
        .Execute
    End With
    s2 = Selection.Range.Start - 1
    doc.Range(s1, s2).Copy
    dp.Activate
    Selection.EndKey unit:=wdStory
    Selection.InsertParagraphAfter
    Selection.EndKey unit:=wdStory
    Selection.Paste
Next
dp.Save
dp.Close
End Sub

凌空一羽

gbgbxgb

试试附件（估计楼主要提出重编题号的需求了）。

thunor

你的意思是原来有题号，现在需要删除原来的题号建立新的题号，是这个的意思吗？如果是，这很简单，两行命令可以解决。
你的附件因为我这台电脑装的是2003，打开时出错，所以一些内容可能看不到。

thunor

建立一个域，内容为："{ SEQ .\*Arabic \* MERGEFORMAT }．"(引号内内容)，选中并剪切。
然后对文本进行替换操作：查找：“(^13)([0-9]{1,2})([、])”；替换：“\1^c”；使用通配符。
完成后全选内容，右键，更新域。

douzi198634

凌空一羽 发表于 2020-8-5 13:42
Sub lkyy()
Dim doc As Document, Mp$, dp As Document
Set doc = ActiveDocument

感谢大神！

douzi198634

凌空一羽 发表于 2020-8-5 13:43

感谢大神！

douzi198634

gbgbxgb 发表于 2020-8-5 16:24
试试附件（估计楼主要提出重编题号的需求了）。

感谢大神！

douzi198634

thunor 发表于 2020-8-6 09:31
建立一个域，内容为："{ SEQ .\*Arabic \* MERGEFORMAT }．"(引号内内容)，选中并剪切。
然后对文本进行替 ...

感谢大神！