нужна помощь

[wander_vafl9]

писал ранее, но никто не помог! вот упрощенный вопрос:
Текст макроса:

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

необходимо считать все числа в тексте, но если число 2-х значное, 3-х и т.д., то все равно считать за 1 число! + теперь надо учитывать одинаковые числа как 1!
как я понял необходимо переделать эту строку .Text = "<[0-9]@>{2;}" , но я без понятия как. помогите пожалуйста!
или тут закончились люди знающие язык VBA при создании макросов в Worde!

[shanemac51]

необходимо считать все числа в тексте, но если число 2-х значное, 3-х и т.д., то все равно считать за 1 число! + теперь надо учитывать одинаковые числа как 1!

2 ииииииии 22 иииииииииии 2 ооооооооо 2222 оооооооо

====
какой ответ
1зн-1 число, 2 повтора
2зн-1 число
4зн-1 число

или всего=3 уникальных

[wander_vafl9]

Сообщение от shanemac51

2 ииииииии 22 иииииииииии 2 ооооооооо 2222 оооооооо

====
какой ответ
1зн-1 число, 2 повтора
2зн-1 число
4зн-1 число

или всего=3 уникальных

1 2 2 234 222 345 234
выведет сообщение, что чисел 5, т.е. не будет учитывать повторы за число!

[shanemac51]

может этот вариант подойдет

Sub w131127_1426()
Dim w1 As Object
Dim ss, s1, s2
For Each w1 In Word.ActiveDocument.Words

s2 = " " & Trim(w1.Text) & " "
If InStr(ss, s2) = 0 Then
If s2 Like " [0-9]* " Then

Debug.Print "="; s2; "=";
ss = ss & s2
End If
End If
Next w1
Word.Documents.Add
Word.ActiveDocument.Paragraphs(1).Range.Text = Replace(ss, "  ", " ")
End Sub

[wander_vafl9]

Сообщение от shanemac51

может этот вариант подойдет

Sub w131127_1426()
Dim w1 As Object
Dim ss, s1, s2
For Each w1 In Word.ActiveDocument.Words

s2 = " " & Trim(w1.Text) & " "
If InStr(ss, s2) = 0 Then
If s2 Like " [0-9]* " Then

Debug.Print "="; s2; "=";
ss = ss & s2
End If
End If
Next w1
Word.Documents.Add
Word.ActiveDocument.Paragraphs(1).Range.Text = Replace(ss, "  ", " ")
End Sub

спасибо хоть на этом, но открытие нового документа это лишняя работа!)
попробую сейчас разобраться полностью с кодом и сделать, то что нужно! Спасибо за помощь!
но если вас интересует программа не должна убирать повторные элементы, а считать все числа в открытом файле, кроме повторных!
т.е. есть числа: 1 2 2 4 22
выведет отчет о нахождении 4 чисел.

[wander_vafl9]

и еще один не менее важный момент то, что он удаляет и игнорирует текст, а он его должен не трогать вообще)

[shanemac51]

код ничего не удаляет
при этом создает перечень номеров в новом файле

===
заменить список на количество в msgbox ---20 секунд

[wander_vafl9]

Сообщение от shanemac51

код ничего не удаляет
при этом создает перечень номеров в новом файле

===
заменить список на количество в msgbox ---20 секунд

с mxgbox согласен!) но у меня текст Макроса удаляет текст и создает новый только с цифрами!) для проверки моих утверждений я открыл файл с кучей текста и небольшим количеством цифр и он удаляет текст))) не стал бы врать в глаза!

[shanemac51]

он создает 2-й документ, а не портит основной

[shanemac51]

без создания документа

Sub w131127_1528()
Dim w1 As Object, j1
Dim ss, s1, s2
For Each w1 In Word.ActiveDocument.Words

s2 = " " & Trim(w1.Text) & " "
If InStr(ss, s2) = 0 Then
If s2 Like " [0-9]* " Then
j1 = j1 + 1
Debug.Print "="; s2; "=";
ss = ss & s2
End If
End If
Next w1
MsgBox "номеров " & j1 & Chr(13) & Chr(10) & ss
'Word.Documents.Add
'Word.ActiveDocument.Paragraphs(1).Range.Text = Replace(ss, "  ", " ")
End Sub