Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Sub ()
- Dim di As Object, x, i As Long
- Set di = CreateObject("scripting.dictionary")
- di.comparemode = vbTextCompare 'не различать регистр букв
- 'наполнение словаря
- For Each x In ActiveDocument.Sentences
- x.MoveEndWhile vbCr & " ", wdBackward 'не учитывать знак абзаца и пробел после предложения
- di(x.Text) = di(x.Text) + 1
- Next
- 'удаление значений равных 1
- For Each x In di.keys
- If di(x) = 1 Then di.Remove x
- Next
- If di.Count = 0 Then MsgBox "повторяющихся нет!": Exit Sub
- 'запись в новый документ
- With Documents.Add
- With .Tables.Add(.Range, di.Count, 2)
- For Each x In di.keys
- i = i + 1
- .Cell(i, 1).Range.Text = x
- .Cell(i, 2).Range.Text = di(x)
- Next
- End With
- End With
- End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement