Word VBA刪除大文檔（長文檔）重複標題段落
Word VBA刪除大文檔（長文檔）重複標題段落
一、刪除重複段落常用方法
有一些word文檔存在許多重複的內容需要去除。人工查找這些重複的內容，不僅費時費力，而且很可能不能做到完全去重，所以要找到一些快速批量去除重複的辦法。
在word中刪除重複段落的方法，在網路上有很多，一般都是寫正則表達式。具體做法如下：
（1）Ctrl+H調出查找和替換對話框，勾選「使用通配符」
查找內容：^13(?*^13)(*)1
替換：^p12
連續或非連續的重複段落均可去除，保留的是重複段落中第一個出現的段落。替換前將游標置於文檔最開始的位置，需要點擊「全部替換」多次，直到提示「0處替換」即可。
（2）Ctrl+H調出查找和替換對話框，勾選「使用通配符」
查找內容：^13(?*^13)1
替換：^p1
這可以去除連續的重複段落，保留的是重複段落中第一個出現的段落。替換前將游標置於文檔最開始的位置，需要點擊「全部替換」多次，直到提示「0處替換」即可。
如果確定文檔的重複段落是連續的，那麼可以使用方法（2）進行去除，運行速度會比較快；如果不確定，就用方法（1）。
以上方法對付小文檔還是可以的，如果遇上百萬字的大文檔，就不太好用了。
二、大文檔去除重複段落
一些大文檔，大幾百頁，一百多萬字。普通的辦公電腦，使用上述方法進行去除，word程序將會長時間不響應，那個圈圈一直在轉。況且要點擊替換多次，時間就更長了。甚至程序直接崩潰。
前幾天就碰到一個這樣的文檔，有868頁，1171600字，直接用上述方法進行去除重複段落，幾次嘗試之後，都以無法忍受word長時間不響應而告終。
後來，觀察文檔，發現重複的段落都是以字元串「<目錄>」開始的。這些段落其實就是文檔中每篇文章的標題。如果把所有以「<目錄>」開始的段落設置為標題1樣式後，可以在導航窗格中看到這個文檔的結構圖，如下圖所示。這樣的標題一共有746個，分布在文檔各處。
手工刪除
如果手工刪除，可以這樣做。瀏覽左側的導航窗格，把重複的標題段落中的第一個標題留下並設置為其他樣式，其它不管。這樣瀏覽完整個文檔後，所以想要保留的標題都應該設置成了其他樣式。如果不放心可以再檢查一遍。
然後用查找替換的功能，把所有標題1樣式的段落刪除，這還是很容易做到的。查找替換對話框的設置如下圖所示。在「查找內容」中不輸入任何字元，只需要限定樣式為「標題1」，在「替換為」中不輸入任何字元。需要去除勾選「使用通配符」，然後點擊「全部替換」，很快重複的標題就全部被刪除了。
但是這樣的方法最少也需要半天的時候，而也可能出現遺漏或誤刪。
使用vba刪除重複標題
還可以使用vba編寫代碼的方式來快速完成。思路為：把所有以「<目錄>」開頭的段落設置為標題1樣式；為標題1樣式的段落加上編號，為使用listparagraphs對象做準備；使用兩層嵌套循環，把標題1段落兩兩比較，把除了第一個標題以外的所有標題設置為斜體；最後刪除所有斜體的標題1段落，從而達到刪除重複標題段落的目的。代碼如下：
Sub 刪除大文檔重複標題()
Dim i As Long, j As Long
Dim biaoti As Paragraph
Dim StartTime As Single, EndTime As Single
StartTime = Timer
Application.ScreenUpdating = False
將所有以「<目錄>」開頭的段落設置為標題1樣式
Selection.find.ClearFormatting
Selection.find.Replacement.ClearFormatting
Selection.find.Replacement.Style = ActiveDocument.Styles("標題 1")
With Selection.find
.Text = "<目錄>*^13"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchWildcards = True
End With
Selection.find.Execute Replace:=wdReplaceAll
為標題1加上自動編號，為使用listparagraphs做準備
With ListGalleries(wdNumberGallery).ListTemplates(1).ListLevels(1)
.NumberFormat = "%1"
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = CentimetersToPoints(0)
.Alignment = wdListLevelAlignLeft
.TextPosition = CentimetersToPoints(0.74)
.TabPosition = wdUndefined
.ResetOnHigher = 0
.StartAt = 1
.LinkedStyle = "標題 1"
End With
ActiveDocument.Styles("標題 1").LinkToListTemplate ListTemplate:= _
ListGalleries(wdNumberGallery).ListTemplates(1), ListLevelNumber:=1
每一個標題都和其他標題比較一次，如果兩標題相同，把下一標題設置為斜體，以區別於要保留的唯一標題
For i = 1 To ActiveDocument.ListParagraphs.Count
If ActiveDocument.ListParagraphs(i).Range.Font.Italic = False Then 去除已經比較過的標題,提高程序效率
Set biaoti = ActiveDocument.ListParagraphs(i) 獲取第一個標題，並賦值給biaoti
把下面的所有標題與biaoti比較，相同，則斜體。
For j = (i + 1) To ActiveDocument.ListParagraphs.Count
If biaoti.Range = ActiveDocument.ListParagraphs(j).Range Then
ActiveDocument.ListParagraphs(j).Range.Font.Italic = True
End If
Next
End If
Next
刪除所有斜體的標題，即重複標題
For Each biaoti In ActiveDocument.ListParagraphs
If biaoti.Range.Font.Italic = True Then
biaoti.Range.Delete
End If
Next
Application.ScreenUpdating = True
EndTime = Timer
MsgBox "用時" & EndTime - StartTime 顯示程序運行時間
End Sub
最後用時195秒，得到了100多個不重複的標題。
代碼中前面兩段都是通過錄製宏的方式得到的，做了一些刪減。後面的兩層嵌套循環比較並標誌重複段落的方法是可行，不過應該會有更好的辦法，不知道有哪位大神賜教！
對於在大文檔中刪除重複段落，最有效率的辦法，應該是先觀察文檔，找到重複段落的一些特徵，再結合查找替換、vba代碼等方式進行刪除。
推薦閱讀：
TAG:MicrosoftWord | VBA | Office文檔 |