Как подсчитать количество букв?

[Skif-F]

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

Ну раз начали выкусывать миллисекунды...:

В нескольких тестах результат Letters3 был меньше 1 мс
Выигрыш впрочем идёт не за счёт Select а из-за

Ура-а! ещё на порядок ускорили! (как минимум на двоичный)

а ещё вот так:

    For i = 1 To ДлинаТекста
        Select Case Asc(Mid(strTemp, i, 1))
            Case 192 To 255, 184, 168 'а-Я'ё,Ё
                rus = rus + 1
            Case 97 To 122, 65 To 90
                eng = eng + 1
        End Select
    Next i

экономим ещё около миллисекунды

[Stilet]

Хы... Я когда-то таким страдал:

Sub b()
 Dim s As String
 s = "привет hello мир"
 Dim a(2) As Integer
 Dim i As Long
 For i = 1 To Len(s)
   'a(1) = Asc(Mid(s, i, 1))
   a(CByte((Asc(Mid(s, i, 1)) > Asc("А") And 1))) = a(CByte((Asc(Mid(s, i, 1)) > Asc("А") And 1))) + 1
 Next i
 Debug.Print a(0), a(1)
End Sub

Правда скорость не измерял...

[Skif-F]

Дорогой Stilet, Вы не учли возможность присутствия в тексте не буквенных символов, а скорость всё равно ниже, чем у программы из 11 сообщения

[Sdwjisa]

сори за ап такой темы. но сейчас интересует как подсчитать кол-во знаков русского языка в тексте где русский. английский и различные символы. некоторые макросы зависают просто

[Aleksandr H.]

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

сори за ап такой темы. но сейчас интересует как подсчитать кол-во знаков русского языка в тексте где русский. английский и различные символы. некоторые макросы зависают просто

http://programmersforum.ru/showpost....7&postcount=11
пробовали?

[Sdwjisa]

Сообщение от Aleksandr H.

http://programmersforum.ru/showpost....7&postcount=11
пробовали?

это весь текст макроса?
можете скинуть файлом пожалуйста а то я криворукий))

[Aleksandr H.]

Чем макросы с первой страницы не устраивают?
http://programmersforum.ru/showpost....88&postcount=7

[Sdwjisa]

Сообщение от Aleksandr H.

Чем макросы с первой страницы не устраивают?
http://programmersforum.ru/showpost....88&postcount=7

зависают на определенной странице

[shanemac51]

Sub RusLettersEngLetters2() 'подсчёт букв в документе (кроме сносок, надписей, колонтитулов и рисунков)'
Dim rus As Long, eng As Long, oth As Long, i As Long
Dim dt
dt = Timer
Dim c1 As Object, s1
For Each c1 In ActiveDocument.Range.Characters
    i = i + 1
    
    s1 = c1
    If s1 Like "[А-яЁё]" Then
    rus = rus + 1     'счётчик русских букв'
    ElseIf s1 Like "[A-z]" Then
    eng = eng + 1         'счётчик нерусских букв'
    Debug.Print i;
    Else
    oth = oth + 1 'счётчик прочих знаков текста документа'
    End If
    Next c1
Debug.Print
Debug.Print "В документе «" & ActiveDocument & "»"
Debug.Print "русских букв:", rus
Debug.Print "английских букв:", eng
Debug.Print "всего русских и английских букв:", rus + eng
Debug.Print "прочих символов:", oth
Debug.Print "символов по статистике Word:" & Chr(9) & ActiveDocument.ComputeStatistics(wdStatisticCharactersWithSpaces)
Debug.Print (dt - Timer) \ 1, "sec"
''==============================================================
''расчет по топику 2 занял бы 120 мин(сняла, не хватило терпения)
''по топику 6(find) --43 сек
''------------------------перебор символов 9 секунд
End Sub

[Вождь]

Как-то все зациклились на циклах

Думаю, быстро получится через Replace. Можно VBA.Replace, а можно и RegExp.Replace. Что-то типа:

Sub A()
Dim O As Object, S$, L&, N&, N2&, T!
    T = Timer
    S = ActiveDocument.Range.Text
    L = Len(S)
    Set O = CreateObject("VBScript.RegExp")
    O.Global = True
    O.IgnoreCase = True
    O.Pattern = "[А-ЯЁа-яё]"
    S = O.Replace(S, "")
    N = L - Len(S)
    O.Pattern = "[A-Za-z]"
    S = O.Replace(S, "")
    N2 = L - N - Len(S)
    T = Round(Timer - T, 4)
    MsgBox "Русских букв: " & N & vbLf & "Английских букв: " & N2 & vbLf & "Время, сек: " & T
End Sub