请高手朋友帮忙！删除行号和换行符的问题，谢谢啦！！

413191246se

* 谢谢 wdpfox 朋友，我认为年月日是突破点。
* 楼主，可能运行较慢，请耐心等待一会儿就好。请注意留底（打包原文件备份保存）。
*

1. Sub aaaa日记整理()
   
2.     Dim i As Paragraph
   
3.     With ActiveDocument
   
4.         With .Content.Find
   
5.             .Execute "[^13^l]", , , 1, , , , , , "", 2
   
6.             .Execute "\(", , , 1, , , , , , "（", 2
   
7.             .Execute "\)", , , 1, , , , , , "）", 2
   
8.             With .Parent
   
9.                 .Select
   
10.                 Selection.ClearFormatting
    
11.                 With .Font
    
12.                     .NameFarEast = "宋体"
    
13.                     .NameAscii = "Times New Roman"
    
14.                     .Size = 16
    
15.                     .Color = wdColorBlue
    
16.                     .Kerning = 0
    
17.                     .DisableCharacterSpaceGrid = True
    
18.                 End With
    
19.                 With .ParagraphFormat
    
20.                     .Space15
    
21.                     .CharacterUnitFirstLineIndent = 2
    
22.                     .AutoAdjustRightIndent = False
    
23.                     .DisableLineHeightGrid = True
    
24.                 End With
    
25.             End With
    
26.             .Execute "([0-9]{2,4}.[0-9]{1,2}.[0-9]{1,2})", , , 1, , , , , , "^p^&", 2
    
27.         End With
    
28.         For Each i In .Paragraphs
    
29.             With i.Range
    
30.                 If InStr(.Text, ".") = 3 Then .InsertBefore Text:="20"
    
31.                 If InStr(.Text, ".") = 4 Then .InsertBefore Text:="2"
    
32.                 If .Text Like "[!2]*" Then .Font.ColorIndex = wdRed 'check
    
33.             End With
    
34.         Next
    
35.         With .Content
    
36.             With .Find
    
37.                 .Execute "([0-9]{4}).([0-9]{1,2}).([0-9]{1,2})", , , 1, , , , , , "\1年\2月\3日", 2
    
38.                 .Execute "([。）])[!。）]@android.cursor.item[!^13]@(^13)", , , 1, , , , , , "\1\2", 2
    
39.                 .Execute "(（ 0 : B J ` h[!^13]@)(^13)", , , 1, , , , , , "\2", 2
    
40.                 .Execute "([!^1-^127][!^1-^127])\1", , , 1, , , , , , "\1", 2
    
41.                 With .Parent
    
42.                     .Select
    
43.                     CommandBars.FindControl(ID:=122).Execute
    
44.                     CommandBars.FindControl(ID:=123).Execute
    
45.                 End With
    
46.                 .Execute "([!^13]@^13)\1", , , 1, , , , , , "\1", 2 'del-dup
    
47.                 If MsgBox("是否在段落间留空？", 4 + 16) = vbYes Then .Execute "^p", , , 0, , , , , , "^p^p", 2
    
48.             End With
    
49.             Do While .Text Like "*" & vbCr & vbCr
    
50.                 .Characters.Last.Delete
    
51.             Loop
    
52.         End With
    
53.         If MsgBox("是否标红年月日？", 4 + 16) = vbYes Then
    
54.         For Each i In .Paragraphs
    
55.             If i.Range Like "*日*" Then
    
56.                 With ActiveDocument.Range(i.Range.Start, i.Range.Characters(InStr(i.Range, "日")).End).Font
    
57.                     .Bold = True
    
58.                     .ColorIndex = wdPink
    
59.                     .Underline = wdUnderlineWavyHeavy
    
60.                 End With
    
61.             End If
    
62.         Next
    
63.         End If
    
64.     End With
    
65.     With ActiveWindow.ActivePane.View.Zoom
    
66.         .PageColumns = 3
    
67.         .PageRows = 1
    
68.     End With
    
69.     With Selection
    
70.         If MsgBox("是否设置为默认格式？", 4 + 16) = vbYes Then
    
71.             .WholeStory
    
72.             .ClearFormatting
    
73.             .HomeKey 6
    
74.         End If
    
75.     End With
    
76. End Sub

复制代码

scmydms

413191246se 发表于 2020-9-13 02:21
* 谢谢 wdpfox 朋友，我认为年月日是突破点。
* 楼主，可能运行较慢，请耐心等待一会儿就好。请注意留底（ ...

非常感谢朋友！代码也非常好用运行没有问题的啦！

scmydms

谢谢朋友们的关注问题解决了