Макрос на поиск (помочь переделать)!!

[wander_vafl9]

недавно писал по поводу поиска чисел в Worde и просил о помощи в написании макроса! все вроде хорошо, но задачу изменили:
нужен был поиск по числам во всем документе даже если они 2-х значные и т.д., но теперь добавилось условие! необходимо еще учитывать повторы чисел, т.е. если есть 2 и 2 то это не 2 числа, а одно! и если 2 и 23, то это 2 разных числа.
код прошлого макроса:

Sub Find1()
Dim Счётчик As Long
Счётчик = 0
With ActiveDocument.Range.Find
.Text = "<[0-9]@>"
.Replacement.Text = ""
.Forward = True
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
Do While (.Execute = True) {And (Счётчик < 500)}
Счётчик = Счётчик + 1
Loop
End With
MsgBox ("найдено " & Счётчик & " чисел в тексте")
End Sub

в таких кавычках {} показана информация, которая была упразднена и не влияет особо на исход макроса (счетчик меньше 500, а если чисел больше, можно и без этого)
просьба помочь!)
нашел пример с пробелами (поиск 2 и более и замена их на 1) и пробовал его переделать, но не сумел переделать его в необходимый(вот он):

Sub probeli()
Selection.WholeStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFor matting
With Selection.Find
.Text = " {2;}"
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub

вот, что получилось из моих трудов и имея 2 разных макроса :

Sub proba1()
Dim Счетчик As Long
Счетчик = 0
Selection.WholeStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFor matting
With ActiveDocument.Range.Find
.Text = "<[0-9]@>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
Do While (.Execute = True)
Счетчик = Счетчик + 1
Loop
End With
MsgBox ("Найдено " & Счетчик & " чисел в тексте")
Selection.MoveRight unit:=wdCharacter, Count:=1
End Sub