Возможно ли оптимизировать макрос

[Vadim39]

Доброго времени суток!
Требуется получить список всех знаков, используемых в документе.
Наваял нижеприведенный код. Работает, Но очень медленно. Возможна ли оптимизация?
ЗарСпасБол!

Sub pr1()
Dim sl As String, i As Long
With ActiveDocument.Range.Characters
    For i = 1 To .Count
        If InStr(sl, .Item(i)) = 0 Then sl = sl + .Item(i)
    Next
End With
Debug.Print sl

End Sub

[Скрипт]

Пункт 1

Вот такой вариант, хотя если точно не уверены, что к чему, то лучше использовать VBA-Word-средства, а не просто VBA-средства.

Можно попробовать использовать VBA-Word-средства, например, просмотр каждого символа в документе, и использование объекта "Dictionary".

Sub Procedure_1()
    
    'Подключите библиотеку:
        'Tools - References.. - Microsoft Scripting Runtime.
    Dim myDictionary As Scripting.Dictionary
    Dim myText As String
    Dim i As Long
    
    'Создаём объект "Dictionary" и даём ему имя "myDictionary".
    'Через это имя будем обращаться к "Dictionary".
    Set myDictionary = CreateObject(Class:="Scripting.Dictionary")
    
    'Берём вообще весь текст из основной части документа в переменную "myText"
    myText = ActiveDocument.Range.Text
    
    'Проходимся по всем символам в переменной "myText".
    For i = 1 To Len(myText) Step 1
        'Если в словаре нет такого символа.
        If myDictionary.Exists(Mid(myText, i, 1)) = False Then
            'Добавляем элемент в словарь.
            '"Item" нужно обязательно указывать, хоть нам оно и не нужно.
            myDictionary.Add Key:=Mid(myText, i, 1), Item:=""
        End If
    Next i
    
    For i = 0 To myDictionary.Count - 1 Step 1
        'Вывод уникальных слов в View - Immediate Window.
        Debug.Print myDictionary.Keys(i)
    Next i
    
End Sub

Пункт 2

В вашем коде, нужно добавлять новые данные не ко всей строке, а сделайте ещё одну переменную. В эту переменную помещайте, например, по 100 символов, а затем эти символы добавляйте в основную строку. И т.д. Так будет быстрее, чем добавлять каждый символ к основной строке.

[shanemac51]

хотя бы

Sub pr1()
Dim sl As String, i As Long,jc as long
With ActiveDocument.Range.Characters
jc=.count
    For i = 1 To jc
        If InStr(sl, .Item(i)) = 0 Then sl = sl + .Item(i)
    Next
End With
Debug.Print sl

End Sub

[Скрипт]

shanemac51, можно не помещать данные в переменную, а затем использовать эту переменную в цикле, т.к. расчёт:

ActiveDocument.Range.Characters.Count

только один раз происходит в цикле, а не при каждом витке цикла (виток цикла по-научному называется "итерация").

[shanemac51]

попробуйте так

Sub pr1a()
Dim DT, j2
Dim c1
DT = Timer
j2 = 0
Dim sl As String, i As Long
For Each c1 In ActiveDocument.Range.Characters
      If InStr(sl, c1) = 0 Then
        sl = sl + c1
        j2 = j2 + 1
      End If
    Next c1
Debug.Print
Debug.Print Timer - DT
Debug.Print sl

End Sub

хотя видимо задача сложнее
--есть символы unicode
--ничего не говорится о регистрах п/П, а/А

[Vadim39]

Большое всем спасибо!
У меня в конце концов получилось следующее:

Sub Uni()
'Уникальные буквы в документе
Dim sl As String, j As String, i As Long
tm = Timer
    strTemp = ActiveDocument.Content.Text           'загружаем текст в переменную
    Ln = Len(strTemp)                               'длина текста
    For i = 1 To Ln
        j = Mid(strTemp, i, 1)                      'можно и без этого
        If InStr(sl, j) = 0 Then
            sl = sl + j + " "
        End If
    Next i
    
    Debug.Print sl
    Debug.Print "Uni: Подсчёт занял " & Timer - tm & "секунд."
    Debug.Print "Длина оригинала - " & Str(Ln) & " знаков"
End Sub

Так же быстро, как и в примере уважаемого Скрипта.
Правда, я не совсем понял реплику насчет того, что нет необходимости помещать ActiveDocument... в переменную. В вышеуказанном виде скрипт работает меньше двух секунд с текстом ~900 тысяч знаков. Когда же я заменил "strTemp" на "ActiveDocument.Content.Text", дождаться конца его работы мне не удалось

[Скрипт]

Vadim39: Правда, я не совсем понял реплику насчет того, что нет необходимости помещать ActiveDocument... в переменную.

В каком сообщении такая реплика?

Дело в том, что в Word-документе может быть много всего (таблицы, рисунки, автоматизированные поля, элементы управления (кнопки и другое), сноски, выноски и т.д.), и это усложняет работу с Word-документом, т.к. нужно учитывать много деталей. Если вы редко делаете макросы для программы "Word", то можете не учесть какую-нибудь деталь.

Когда вы помещаете документ в переменную, то в переменной Word-документ уже находится не так, как он находится в программе "Word". И VBA-средствами (пример VBA-средства - InStr) вы уже работаете не так, как работали бы VBA-Word-средства (пример VBA-Word-средства - Character) с документом.

Поэтому нужно чётко представлять - будет ли получен такой же результат при использовании только VBA-средств.

[Скрипт]

Vadim39, зачем вы используете лишнюю переменную, усложняя таким образом чтение кода?

Ln = Len(strTemp)

А эта строка:

j = Mid(strTemp, i, 1)

не лишняя. Вы таким образом вместо двух раз только один раз вызываете функцию "Mid", что логичнее и по идее должно даже ускорить работу кода.

[Vadim39]

Скрипт, Спасибо за объяснения!
Насчет Ln = Len(strTemp) Вы совершенно правы, просто я привел пример кода, а значение длины нужно несколько раз.
Пользуясь случаем, хочу попросить совета по другому поводу. Или лучше создать новую тему? Вопрос такой:
Нужно запустить из макроса диалог поиска и замены, причем курсор должен оказаться в начале поля замены.
Если вызвать Dialogs(wdDialogEditReplace).Show, то после выполнения замены появляется сообщени об ошибке. Кроме того, я не знаю как перемещать курсор внутри диалогового окна.
Если же вызывать диалог с помощью SendKeys "^h", все отлично, и следующие за ним SendKeys "{TAB}"
SendKeys "{HOME}"
ставят курсор в нужное место, но возникает другая проблема: все это работает только, в том случае, если в момент вызова раскладка клавиатуры английская, если же русская - вместо вызова диалога в документ впечатываются "h" и знак табулятора.
Если принципиального решения не существует, то может кто-нибудь подскажет, как написать скрипт для определения и управления раскладкой клавиатуры.

ЗарСпасБол!

[Скрипт]

Vadim39, создайте новую тему, если новый вопрос никак не связан с этой темой.

Это увеличит вероятность, что вам помогут, т.к. перелистывать 10 веб-страниц не каждому захочется, а посмотреть короткую тему, желание может возникнуть.