删除多余空白段和插入空白段的VBA

ke3088

处理前：


处理后的效果：


处理前：



处理后的效果：



向各位大师求助以下循环代码：
1.第一节最后段（即段前二字为“出席”）与正文之间空白段落（行）在2个以上的，保留1个空白段落，其他删除；
2.最后段与正文之间没有空白段落的，插入1个空白段落。
一行一行的往上找效率太慢了，谢谢！
返回一节的代码已解决：
Sub 一节末段首()
    If ActiveDocument.Sections.Count > 1 Then
       n = 2
    Else
       n = 1
    End If
    Dim ccdoc As Document, rng As Range
    Set ccdoc = ActiveDocument
    With ccdoc.Sections(1)
         Set rng = ccdoc.Range(.Range.End - n, .Range.End - n)
         rng.Select
    End With
    With Selection
         ActiveDocument.Range(.Paragraphs(1).Range.Start, .Paragraphs(1).Range.Start).Select
    End With
End Sub

413191246se

楼主，我有两个小宏test1/test2，虽然功能一样，但test1是极简的！请试用：

1. Sub test1()
   
2.     ActiveDocument.Content.Find.Execute "[^13^11 　^s^t]@(出席：)", , , 1, , , , , , "^p^p\1", 2
   
3. End Sub
   
4. Sub test2()
   
5.     With ActiveDocument
   
6.         '回车符/手动换行符=>段落标记
   
7.         .Content.Find.Execute "[^13^11]", , , 1, , , , , , "^p", 2
   
8.         .Select
   
9.         CommandBars.FindControl(ID:=122).Execute
   
10.         CommandBars.FindControl(ID:=123).Execute
    
11. 
    
12.         '删除空行
    
13.         Dim i As Paragraph
    
14.         For Each i In .Paragraphs
    
15.             If Asc(i.Range) = 13 Then i.Range.Delete
    
16.         Next
    
17. 
    
18.         '插入空行
    
19.         With .Content.Find
    
20.             .ClearFormatting
    
21.             .Text = "^13出席："
    
22.             .Forward = True
    
23.             .MatchWildcards = True
    
24.             Do While .Execute
    
25.                 With .Parent
    
26.                     .InsertParagraphBefore
    
27.                     .Start = .End
    
28.                 End With
    
29.             Loop
    
30.         End With
    
31.         .Range(0, 0).Select
    
32.     End With
    
33. End Sub

复制代码

ke3088

413191246se 发表于 2019-5-7 00:43
楼主，我有两个小宏test1/test2，虽然功能一样，但test1是极简的！请试用：

413191246se老师，谢谢您。稍后有空试试

ke3088

413191246se老师，由于前段时间比较忙，一直没有运用您的代码，今天才试用，ActiveDocument.Content.Find.Execute "[^13^11 　^s^t]@(出席：)", , , 1, , , , , , "^p^p\1", 2，这一句特别好用，就是我想要的效果，再次衷心感谢！