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
Андрей VG, добрый день! Спасибо Мне как-то комфортнее для восприятия синтаксис записей, чем вложенный let .. in. Редкий случай, когда syntax sugar менее лаконичен, чем вариант "без сахара"
Нет, из-за двух пробелов после 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))
ошибку начало выдавать в последнем варианте (макрос создаю с помощи записи макроса при вставке формулы в ячейку, предпоследний вариант #3 сработал - последний #13 выдает ошибку). Как я понял превышает кол-во символов 255. Нельзя ли как то чуточку сжать формулу с тем же эффектом?
Если можно, чуточку усложню задачу: найти первое русское слово, состоящее из 3 и более букв! Пример: было: ЭС 150-50 УБ Экран под ванну ODA "Универсал" (белый) 1,50х0,50 стало: Экран
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, Спасибо за целых 2 варианта. Вариант с макросом: что надо поменять, если данные находятся во 2 столбце, а не в 1 ? И как допустить в середине слова тире ( например Кран-букс ) ?
Примерно так: RegEx.Pattern = " ([А-Яё\-]{" & MinLength & ",})\.? " И после такого изменения кода нажать в VBE - Run -Reset Но лучше приложите книгу с тем, что есть и как нужно, а то по чайной ложке долго можно спрашивать-отвечать
ZVI написал: по чайной ложке долго можно спрашивать-отвечать
Дык, понятно же что камаз под водой Стандартная схема заказчика: 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()
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, спасибо. Если несложно, что добавить в макрос, чтобы в столбце 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