Страницы: Пред. 1 2
RSS
Как из текста-каши получить первое русское слово
 
getana, а какое отношение этот Ваш вопрос имеет к заявленной теме?
 
Юрий М, Каша из топора :-)
По вопросам из тем форума, личку не читаю.
 
ZVI,  идеальный для меня результат на 100% -  спасибо всем, кто помогал!
Вспомнил очень важный момент всего этого дела: как в примере ниже исключить еще слова, содержащие в конце слова ая или ый ? Например, слова "белый" или "душевая" (цель убрать прилагательные) ?
Изменено: getana - 20.07.2019 08:23:24
 
Цитата
getana написал:
Вспомнил очень важный момент
Был бы важный - не забыли.
И опять старая песня: вопрос не имеет отношения к этой теме.
 
Цитата
getana:... исключить еще слова, содержащие в конце слова ая или ый ? Например, слова "белый" или "душевая"
Рад был помочь. Всё можно сделать, но только по правилам форума (один вопрос в теме). Кстати, слово "душевая" может быть как прилагательным, так и существительным (например, в "Душевая колонная, хром")
 
Юрий М, БМВ, ZVI,Спасибо. Создал новую тему "Как из текста при получении русского слова исключить слова, содержащие в конце слова ая или ый или ое?"
 
при заносе слова в исключение (белый список) заметил, что не учитывается очередность нахождения 1 слова из исключения. В приложении привел пример

Код
  Const MinLength = 4         ' Мин. длина слова в символах
  Const ExcludeList = "ая,ый,ое,ий,ой,ые,яя,ся,ее"  ' Окончания игнорируемых слов
  Const Pattern1 = "[\u00A0,\.\/ ]"  ' 1-й символ это CHR(160), последний - пробел
  Const Pattern2 = "\b_([А-ЯЁ\-]{" & MinLength & ",})[( ]"
    
  Dim i As Long, a() As Variant, Obj As Object, Rng As Range, s As String
  
  ' Задать диапазон входных данных
  With ThisWorkbook.Sheets(1)
    Set Rng = .Range("a2", .Cells(.Rows.Count, "a").End(xlUp))
  End With
  a() = Rng.Value
      
  ' Найти первое русское слова по шаблону
  With CreateObject("VBScript.RegExp")
    .Global = True
    .IgnoreCase = True
    For i = 1 To UBound(a)
      s = Trim(a(i, 1))
      If Len(s) = 0 Then
        a(i, 1) = Empty
      Else
        a(i, 1) = "(нет)"
        ' --> Исключения из правил
        If InStr(1, s, "душ", 1) > 0 Then a(i, 1) = "душ"
        'If InStr(1, s, "хром", 1) > 0 Then s = Replace(s, "хром", "", Compare:=1)
        ' <-- Конец исключений
        .Pattern = Pattern1
        s = .Replace(s, " _")
        .Pattern = Pattern2
        For Each Obj In .Execute("_" & s & " ")
          s = LCase(Obj.SubMatches(0))
          If InStr(ExcludeList, Right(s, 2)) = 0 Then
            a(i, 1) = s
            Set Obj = Nothing
            Exit For
          End If
        Next
      End If
    Next
  End With
    
  ' Поместить результат в столбец [h]
  Rng.EntireRow.Columns("h").Value = a()
Изменено: getana - 13.11.2019 00:09:05
 
Я вот тоже разродился массивной формулой:
Код
=СЖПРОБЕЛЫ(ПРАВБ(ПОДСТАВИТЬ(ЛЕВБ(A1;ПОИСКПОЗ(0=0;ЧАСТОТА(СТРОКА($1:$99);(ПСТР(ПОДСТАВИТЬ(A1;"-";"Ё");СТРОКА($1:$99);1)<"А")*СТРОКА($1:$99))>3;));" ";ПОВТОР(" ";49));99)) 

*Ещё с кавычками можно поиграться:

Код
=СЖПРОБЕЛЫ(ПРАВБ(ПОДСТАВИТЬ(ЛЕВБ(A1;ПОИСКПОЗ(0=0;ЧАСТОТА(СТРОКА($1:$99);(ПСТР(ПОДСТАВИТЬ(ПОДСТАВИТЬ(A1;"-";"Ё");"""";"Ё");СТРОКА($1:$99);1)<"А")*СТРОКА($1:$99))>3;));" ";ПОВТОР(" ";49));99))
Изменено: Светлый - 13.11.2019 11:30:11
 
Светлый, незачет  :D .
По вопросам из тем форума, личку не читаю.
 
Цитата
БМВ написал:
незачет
Да. Погубило желание укоротить формулу на два символа. Каюсь. Это от недостатка тестовых данных. А такие конструкции, как "отец123" - вообще неожиданность. Отсекаем цифры. Возвращаюсь к "недооптимизированному" варианту:
Код
=СЖПРОБЕЛЫ(ПРАВБ(ПОДСТАВИТЬ(ЛЕВБ(A1;ПОИСКПОЗ(0=0;ЧАСТОТА(СТРОКА($1:$99);(ПСТР(ПОДСТАВИТЬ(ПОДСТАВИТЬ(A1;"-";"Ё");"""";"Ё");СТРОКА($1:$99);1)<"А")*СТРОКА($1:$99))>3;)-1);" ";ПОВТОР(" ";99));99))
Включил ещё "." в русские символы для сокращ. слов:
Код
=СЖПРОБЕЛЫ(ПРАВБ(ПОДСТАВИТЬ(ЛЕВБ(A1;ПОИСКПОЗ(0=0;ЧАСТОТА(СТРОКА($1:$99);(ПСТР(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(A1;".";"Ё");"-";"Ё");"""";"Ё");СТРОКА($1:$99);1)<"А")*СТРОКА($1:$99))>3;)-1);" ";ПОВТОР(" ";99));99))
Не идеал, но стало лучше. Спасибо за урок.
Изменено: Светлый - 14.11.2019 06:49:28
 
Цитата
Светлый написал:
Включил ещё
Вот еслиб еще и файл включен был, то совсем бы было хорошо, а то переводить и править каждый раз напряжно, ну да ладно. Будем считать что работа над ошибками проделана.
По вопросам из тем форума, личку не читаю.
Страницы: Пред. 1 2
Наверх