- 16/2/08
- 10,054
- 3,316
Mình thấy có cái macro này, nó sắp xếp rồi mới xóa trùng nên kết quả sau cùng là kết quả đã dc sắp xếp đó.
PHP:
Sub removeDupWord()
Dim AmountMoved As Long
Dim myRange As Range
Selection.WholeStory
Selection.Sort ExcludeHeader:=False, FieldNumber:="Paragraphs", _
SortFieldType:=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending, _
FieldNumber2:="", SortFieldType2:=wdSortFieldAlphanumeric, SortOrder2:= _
wdSortOrderAscending, FieldNumber3:="", SortFieldType3:= _
wdSortFieldAlphanumeric, SortOrder3:=wdSortOrderAscending, Separator:= _
wdSortSeparateByTabs, SortColumn:=False, CaseSensitive:=False, LanguageID _
:=wdEnglishUS, SubFieldNumber:="Paragraphs", SubFieldNumber2:= _
"Paragraphs", SubFieldNumber3:="Paragraphs"
'start with first paragraph and extend range down to second
Set myRange = ActiveDocument.Paragraphs(1).Range
AmountMoved = myRange.MoveEnd(unit:=wdParagraph, Count:=1)
'loop until there are no more paragraphs to check
Do While AmountMoved > 0
'if two paragraphs are identical, delete second one
'and add the one after that to myRange so it can be checked
If myRange.Paragraphs(1).Range.Text = _
myRange.Paragraphs(2).Range.Text Then
myRange.Paragraphs(2).Range.Delete
AmountMoved = myRange.MoveEnd(unit:=wdParagraph, Count:=1)
Else
'if two paragraphs aren't identical, add the one after
'that to my range, so it can be checked, and drop the first one,
'since it is no longer of interest.
AmountMoved = myRange.MoveEnd(unit:=wdParagraph, Count:=1)
myRange.MoveStart unit:=wdParagraph, Count:=1
End If
Loop
MsgBox ("end")
End Sub
??
