Страницы: 1
RSS
Посчитать сколько строк содержат слова, в которых есть заглавные буквы помимо первой.
 
Доброго дня, камрады!

Прошу помочь с обработкой текста.
Нужно посчитать сколько строк содержат слова в которых есть заглавные буквы помимо первой.

То есть строку 1 не считаем, а строку 2 считаем.
Герой   боев за г. Калинин ст. сержант В. Дегтярев
Герой   боев за г. СУВАЛКИ - командир пулеметного расчета Сержант ИСАКОВ Яков   Николаевич
Пример списка прикрепил.
Изменено: Wyatich - 06.04.2021 19:25:24
 
Цитата
Wyatich написал:
Пример списка прикрепил.
а пример результата хоть для пары строк?
Не бойтесь совершенства. Вам его не достичь.
 
Самео простое что приходит в голову - напротив строки ставится 1 если там есть такие слова и 0 если нет.
То есть не нужно вычленять сами слова, достаточно указать, что в строке такие есть.
 
Код
Sub slova()
    Set diap = Intersect(ActiveSheet.UsedRange, Range("A:A"))
    mas = diap.Value
    ReDim mas2(1 To UBound(mas), 1 To 1)
    For g = 1 To UBound(mas)
        For i = 1 To Len(mas(g, 1)) - 1
            t1 = Mid(mas(g, 1), i, 1)
            t2 = Mid(mas(g, 1), i + 1, 1)
            If t1 = UCase(t1) And t1 <> LCase(t1) And t2 = UCase(t2) And t2 <> LCase(t2) Then mas2(g, 1) = 1
        Next
    Next
    diap.Offset(, 1).Value = mas2
End Sub
 
Wyatich,
Код
Sub mrshkei()
Dim x As Long, i As Long, lr As Long, arr, arr2
lr = Cells(Rows.Count, 1).End(xlUp).Row
arr = Range("A1:A" & lr)
ReDim arr2(1 To lr, 1 To 1)
For i = LBound(arr) To UBound(arr)
    For x = 1 To Len(arr(i, 1))
        x1 = UCase(Mid(arr(i, 1), x, 1))
        x2 = Mid(arr(i, 1), x, 1)
            If x2 Like "[A-ZА-ЯЁ]" Then
                k = k + 1
            End If
    Next x
    arr2(i, 1) = k
    k = 0
Next i
Range("B1").Resize(UBound(arr2), 1) = arr2
End Sub
Не бойтесь совершенства. Вам его не достичь.
 
Оба решения работают, Бахтиёр, Mershik, благодарю за помощь!  
 
Цитата
в которых есть заглавные буквы помимо первой
UDF показывает количество таких слов в ячейке
Код
Function More2(cell$)
Dim mo As Object
 With CreateObject("VBScript.RegExp")
     .Global = True
     .Pattern = "[А-ЯЁ]{2,}"
   If .test(cell) Then
   Set mo = .Execute(cell)
     More2 = mo.Count
   Else
     More2 = ""
   End If
 End With
End Function
Страницы: 1
Наверх