求助vba如何让每一个含【解析】关键词的段落前缀它相对前一个段落的段首数字字符

youxianwei

求助vba如何让每一个含【解析】关键词的段落前缀它相对前一个段落的段首数字字符

youxianwei

问chatgpt3硬是把答案问出来了
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^13█([0-9])([0-9])([0-9]).【解析】"
        .Replacement.Text = "^13【解析】"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll


    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^13█([0-9])([0-9]).【解析】"
        .Replacement.Text = "^13【解析】"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll


    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^13█([0-9]).【解析】"
        .Replacement.Text = "^13【解析】"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll




    Dim 定位词 As String
    定位词 = "【解析】"
    Dim 题号词 As String
    题号词 = "█([0-9]{1,})."
    Dim 本段 As Paragraph
    For Each 本段 In ActiveDocument.Paragraphs       '''''1遍历活动文档所有段落
        If InStr(1, 本段.range.Text, 定位词) > 0 Then         ''''2如果本段搜到定位词【解析】
            If InStr(1, 本段.Previous.range.Text, 题号) > 0 Then        ''''3如果本段的前1段搜到题号词【█111.】
                本段.Previous.range.Select                      '''''''''4选择本段前一段
                With Selection.Find                      '''''''''5搜索题号词
                    .Text = 题号词
                    .Forward = True
                    .Wrap = wdFindStop
                    .Format = False
                    .MatchCase = False
                    .MatchWholeWord = False
                    .MatchWildcards = True
                    .MatchSoundsLike = False
                    .MatchAllWordForms = False
                    If .Execute Then                  '''''''''6如果存在题号词
                        Selection.Copy                '''''7复制题号词
                        本段.range.Select             '''''8选择本段落
                        Selection.Move wdParagraph, -1     '''''9光标移动到段前
                        Selection.Paste      ''''''10粘贴刚才的复制
                    End If
                End With
            End If
        End If
    Next 本段  ' ' ' ' '11遍历下一个含词段落



    ''''光标移动到最后的回车后
    Selection.EndKey Unit:=wdStory
    Do
        Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Loop Until Selection.Characters(1) <> Chr(13)
    Selection.MoveRight Unit:=wdCharacter, Count:=1