Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1 2 След.
RSS
Как из текста-каши получить первое русское слово
 
Как из текста-каши получить первое русское слово?
Было: яч1-df отец123 мама брат.  Стало: мама
Изменено: getana - 20 Июл 2019 18:00:34
 
Покажите файл с десятком вариантов каши.
Если в мире всё бессмысленно, — сказала Алиса, — что мешает выдумать какой-нибудь смысл? ©Льюис Кэрролл
 
=TRIM(MID(SUBSTITUTE(A1;" ";REPT(" ";99));99*(
MATCH(;MMULT(--ISNUMBER(FIND(CHAR(COLUMN($A$1:$GI$1));SUBSTITUTE(LOWER(TRIM(MID(SUBSTITUTE(A1;" ";REPT(" ";99));99*(ROW($A$1:$A$99)-1)+1;99)));"ё";"е")));TRANSPOSE(COLUMN($A$1:$GI$1)^0));)
-1)+1;99))
Изменено: БМВ - 13 Июл 2019 10:21:39
 
БМВ,спасибо
 
Off. А сложность формул все растет... Как бы не случились события из этого рассказа.
Владимир
 
sokol92, Да тут то все прозрачно. Нашли слово, поискали в нем чего не должно быть :-)
 
Цитата
БМВ написал:
тут то все прозрачно
Особенно умножение матриц. :)  
Владимир
 
Цитата
sokol92 написал:
Особенно умножение матриц.
А, это, да я и сам не знаю как это работает :-)
 
Вариант в PQ:
Код
let
    Source = Excel.CurrentWorkbook(){[Name="Table"]}[Content],
    add = Table.AddColumn(Source, "first_word", each [x = Text.Split([Text], " "),
                                                      y = List.Select(x, each List.ContainsAll({"ё","а".."я"}, Text.ToList(_), Comparer.OrdinalIgnoreCase)){0}?]
                                                     [y])
in
    add
Изменено: Aleksei_Zhigulin - 13 Июл 2019 23:56:39
 
Доброе время суток.
Aleksei_Zhigulin, спасибо. Интересный вариант ухода от лямбды или let .. in :)
 
Андрей VG, добрый день! Спасибо :) Мне как-то комфортнее для восприятия синтаксис записей, чем вложенный let .. in. Редкий случай, когда syntax sugar менее лаконичен, чем вариант "без сахара" :)
 
отсюда почему то не вытягивает 1 русское слово:
Артикул: FL 16027 RU,  Расширительный бак (ТС/ХС) Flexcon R 25/1,5 - 6bar
Изменено: getana - 16 Июл 2019 12:02:27
 
Нет, из-за двух пробелов после RU, всеж основано на том, что не должно входить не русских символов , а между пробелами стоит ничего и оно не содержит не русских символов :-),
лечится просто
=TRIM(MID(SUBSTITUTE(TRIM(A1);" ";REPT(" ";99));99*(
MATCH(;MMULT(--ISNUMBER(FIND(CHAR(COLUMN($A$1:$GI$1));SUBSTITUTE(LOWER(TRIM(MID(SUBSTITUTE(TRIM(A1);" ";REPT(" ";99));99*(ROW($A$1:$A$99)-1)+1;99)));"ё";"е")));TRANSPOSE(COLUMN($A$1:$GI$1)^0));)
-1)+1;99))
Изменено: БМВ - 16 Июл 2019 12:13:56
 
БМВ,Спасибо
 
ошибку начало выдавать в последнем варианте (макрос создаю с помощи записи макроса при вставке формулы в ячейку, предпоследний вариант #3 сработал - последний #13 выдает ошибку). Как я понял превышает кол-во символов 255. Нельзя ли как то чуточку сжать формулу с тем же эффектом?
Снимок.PNG (1.34 КБ)
Изменено: getana - 17 Июл 2019 00:26:35
 
getana, https://docs.microsoft.com/en-us/office/vba/api/excel.range.formulaarray?f1url=https%3A%2F%2Fmsdn.microsoft.com%2Fquery%2Fdev11.query%3FappId%3DDev11IDEF1%26l%3Den-US%26k%3Dk(vbaxl10.chm144133)%3Bk(TargetFrameworkMoniker-Office.Version%3Dv16)%26rd%3Dtrue
The FormulaArray property also has a character limit of 255.
Сама ФОРМУЛА 266, и уменьшить я не знаю как.

Но давайте спрячем в имена и все. Уже можно будет ввести очень кратко, да и массивность не нужна.
Изменено: БМВ - 17 Июл 2019 07:41:22
 
Код
ActiveWorkbook.Names.Add Name:="asd", RefersToR1C1:= _
        "=TRIM(MID(SUBSTITUTE(TRIM(RC[-7]),"" "",REPT("" "",99)),99*(" & Chr(10) & "MATCH(,MMULT(--ISNUMBER(FIND(CHAR(COLUMN(R1C1:R1C191)),SUBSTITUTE(LOWER(TRIM(MID(SUBSTITUTE(TRIM(RC[-7]),"" "",REPT("" "",99)),99*(ROW(R1:R99)-1)+1,99))),""ё"",""е""))),TRANSPOSE(COLUMN(R1C1:R1C191)^0)),)" & Chr(10) & "-1)+1,99))"
   

     ActiveSheet.Cells(i, q).Select
       ActiveCell.FormulaR1C1 = "=asd"  

Спасибо - заработало!
Изменено: getana - 17 Июл 2019 02:16:59
 
Если можно, чуточку усложню задачу: найти первое русское слово, состоящее из 3 и более букв!
Пример:
было: ЭС 150-50 УБ Экран под ванну ODA "Универсал" (белый) 1,50х0,50
стало: Экран
Изменено: getana - 17 Июл 2019 02:25:32
 
Вариант кода:
Код
Sub Main()
  Dim i As Long, a() As Variant, Rng As Range
  With ThisWorkbook.Sheets(1)
    Set Rng = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
  End With
  a() = Rng.Value
  For i = 1 To UBound(a)
    a(i, 1) = FirstWordRu(CStr(a(i, 1)))
  Next
  Rng.Columns(2).Value = a()
End Sub

Function FirstWordRu(Txt As String, Optional MinLength As Long = 3) As String
  Static RegEx As Object
  If RegEx Is Nothing Then
    Set RegEx = CreateObject("VBScript.RegExp")
    RegEx.Global = False
    RegEx.IgnoreCase = True
    RegEx.Pattern = " ([А-ЯЁ]{" & MinLength & ",}) "
  End If
  With RegEx.Execute(" " & Txt & " ")
    If .Count > 0 Then FirstWordRu = .Item(0).SubMatches(0)
  End With
End Function
Изменено: ZVI - 17 Июл 2019 04:52:21
 
Цитата
getana написал:
из 3 и более букв!
длиннее, но не сложнее
=TRIM(MID(SUBSTITUTE(TRIM(A5);" ";REPT(" ";99));99*(
MATCH(;MMULT(--ISNUMBER(FIND(CHAR(COLUMN($A$1:$GI$1));SUBSTITUTE(LOWER(TRIM(MID(SUBSTITUTE(TRIM(A5);" ";REPT(" ";99));99*(ROW($A$1:$A$99)-1)+1;99)));"ё";"е")))+
(LEN(SUBSTITUTE(LOWER(TRIM(MID(SUBSTITUTE(TRIM(A5);" ";REPT(" ";99));99*(ROW($A$1:$A$99)-1)+1;99)));"ё";"е"))<3);TRANSPOSE(COLUMN($A$1:$GI$1)^0));)
-1)+1;99))


Но если честно, то так как Вы все равно хотите использовать макрос, то и извлекать это слово лучше самим макросом, или  через UDF.

Off
Цитата
ZVI написал:  04:50:27
Владимир! Не спится? :-)
Изменено: БМВ - 17 Июл 2019 09:38:59
 
Цитата
БМВ написал: Владимир! Не спится? :-)
Михаил, это я во сне написал  :D
 
БМВ, ZVI, Спасибо за целых 2 варианта. Вариант с макросом: что надо поменять, если данные находятся во 2 столбце, а не в 1 ? И как допустить в середине слова тире ( например Кран-букс ) ?
Изменено: getana - 17 Июл 2019 10:57:38
 
Цитата
getana написал:... если данные находятся во 2 столбце, а не в 1
В коде Main вместо Set Rng = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
записать Set Rng = .Range("B1", .Cells(.Rows.Count, 2).End(xlUp))
Изменено: ZVI - 17 Июл 2019 09:31:23
 
ZVI,спасибо. И как допустить в середине русского слова тире ( например Кран-букс ) ? Или точку в конце русского слова (например Смесит. )
Изменено: getana - 17 Июл 2019 11:00:46
 
Я смотрю что тема была названо прям как надо и варится именно каша из топора :-)

Цитата
getana написал:
И как допустить в середине русского слова тире ( например Кран-букс ) ? Или точку в конце русского слова (например Смесит. )
Ну даже формульным вариантом это можно сделать,
=TRIM(MID(SUBSTITUTE(TRIM(A6);" ";REPT(" ";99));99*(
MATCH(;MMULT(--ISNUMBER(FIND(CHAR(COLUMN($A$1:$GI$1));
SUBSTITUTE(SUBSTITUTE(TRIM(SUBSTITUTE(SUBSTITUTE(" "&SUBSTITUTE(LOWER(TRIM(MID(SUBSTITUTE(TRIM(SUBSTITUTE(A6&" ";". ";" "));" ";REPT(" ";99));99*(ROW($A$1:$A$99)-1)+1;99)));"ё";"е");" -";"%")&" ";"- ";"%"));"-";);"%";"-")
))+
(LEN(SUBSTITUTE(LOWER(TRIM(MID(SUBSTITUTE(TRIM(A6);" ";REPT(" ";99));99*(ROW($A$1:$A$99)-1)+1;99)));"ё";"е"))<3);TRANSPOSE(COLUMN($A$1:$GI$1)^0));)
-1)+1;99))


но с учетом моего
Цитата
БМВ написал:
Но если честно, то так как Вы все равно хотите использовать макрос, то и извлекать это слово лучше самим макросом, или  через UDF.
лучше пусть Владимир дополнит парой тройкой символов регулярку, ему даже глаза не надо открывать :-)
Изменено: БМВ - 17 Июл 2019 12:50:18
 
Примерно так:
RegEx.Pattern = " ([А-Яё\-]{" & MinLength & ",})\.? "
И после такого изменения кода нажать в VBE - Run -Reset
Но лучше приложите книгу с тем, что есть и как нужно, а то по чайной ложке долго можно спрашивать-отвечать ;)
Изменено: ZVI - 17 Июл 2019 11:49:57
 
Цитата
ZVI написал:
по чайной ложке долго можно спрашивать-отвечать
Дык, понятно же что камаз под водой  :D
Стандартная схема заказчика:
1. Я все продумал, вот ТЗ сделайте мне вот это!,
2. Сделали, тестируем, ОЙ, я не все продумал, GoTo 1.
Вот горшок пустой, он предмет простой...
 
ZVI, к сожалению в мою программу QuadPrice можно добавить в макрос только 1 функцию. В вашем примере их 2. Можно ли сделать из 2-х одну функцию?
вот такой заработал, но остался вопрос: если условие не выполняется, как сделать чтобы в ячейку прописывалось слово "нету" , а не подставлялось оригинальное значение?:
Код
Dim i As Long, a() As Variant, Rng As Range
  
  Static RegEx As Object
  If RegEx Is Nothing Then
    Set RegEx = CreateObject("VBScript.RegExp")
    RegEx.Global = False
    RegEx.IgnoreCase = True
    RegEx.Pattern = " ([А-ЯЁ\-]{" & "4" & ",})\.? "
  End If                                                              
  
  With ThisWorkbook.Sheets(1)
    Set Rng = .Range("B1", .Cells(.Rows.Count, 2).End(xlUp))    
  End With                                      
  a() = Rng.Value
  For i = 1 To UBound(a)
      With RegEx.Execute(" " & CStr(a(i, 1)) & " ")
        If .Count > 0 Then a(i, 1) = .Item(0).SubMatches(0)
      End With
  Next
  Rng.Columns(8).Value = a()  
Изменено: getana - 19 Июл 2019 00:26:56
 
Цитата
getana написал: ...но остался вопрос...
Код
Sub Main()

  Const MinLength = 4  ' Мин. длина слова в символах
  
  Dim i As Long, a() As Variant, Rng As Range, s As String

  ' Задать диапазон входных данных
  With ThisWorkbook.Sheets(1)
    Set Rng = .Range("B2", .Cells(.Rows.Count, "B").End(xlUp))
  End With
  a() = Rng.Value
  
  ' Найти первоое русское слова по шаблону
  With CreateObject("VBScript.RegExp")
    .Global = False
    .IgnoreCase = True
    .Pattern = " ([А-ЯЁ\-]{" & MinLength & ",})\.? "
    For i = 1 To UBound(a)
      s = Trim(a(i, 1))
      If Len(s) = 0 Then
        a(i, 1) = Empty
      Else
        With .Execute(" " & s & " ")
          If .Count > 0 Then
            a(i, 1) = LCase(.Item(0).SubMatches(0))
          Else
            a(i, 1) = "(нет)"
          End If
        End With
      End If
    Next
  End With
  
  ' Поместить результат в столбец [I]
  Rng.EntireRow.Columns("I").Value = a()
  
End Sub
Изменено: ZVI - 20 Июл 2019 02:41:16
 
ZVI, спасибо. Если несложно, что добавить в макрос, чтобы в столбце I (результат) поменять заглавные все на строчные буквы? И надо чтобы (нет) не писало в столбце I, если исходная ячейка (в примере "B") пустая.
"медленным" макросом временно сделал это так:
Код
For i = 1 To UBound(a) 
 if Sheets(1).Cells(i, 2).Value = "" then
     Sheets(1).Cells(i, q).Value = ""
 end if    
 Sheets(1).Cells(i, q).Value = LCase(Sheets(1).Cells(i, q).Value)
Next i    
Изменено: getana - 20 Июл 2019 00:08:18
Страницы: 1 2 След.
Читают тему (гостей: 1)
Наверх