Добрый день, подскажите как будет выглядеть формула, которая найдёт в столбце А латинское слово и сделает первую букву этого слова Большой. И если этих слов в ячейке >1 то применить такой же метод и к остальным словам (все с большой). Изначально все буквы в ячейке маленькие. Благодарю.
Добрый день, подскажите как будет выглядеть формула, которая найдёт в столбце А латинское слово и сделает первую букву этого слова Большой. И если этих слов в ячейке >1 то применить такой же метод и к остальным словам (все с большой). Изначально все буквы в ячейке маленькие. Благодарю.AdwordsDirect
Option Compare Text Function Propl(t As String) As String txt = Split(t, " ") For i = 0 To UBound(txt) If Left(txt(i), 1) Like "[a-z]" Then txt(i) = StrConv(txt(i), 3) Next i Propl = Join(txt, " ") End Function
Option Compare Text Function Propl(t As String) As String txt = Split(t, " ") For i = 0 To UBound(txt) If Left(txt(i), 1) Like "[a-z]" Then txt(i) = StrConv(txt(i), 3) Next i Propl = Join(txt, " ") End Function
Function ЗаменитьБукву$(s$) With CreateObject("scriptcontrol") .Language = "JScript" ЗаменитьБукву = .eval("'" & s & "'.replace(/(?:^|\b)([a-z])/gi, " & _ "function(a) { return a.toUpperCase(); })") End With End Function
[/vba]
и я того же мнения [vba]
Код
Function ЗаменитьБукву$(s$) With CreateObject("scriptcontrol") .Language = "JScript" ЗаменитьБукву = .eval("'" & s & "'.replace(/(?:^|\b)([a-z])/gi, " & _ "function(a) { return a.toUpperCase(); })") End With End Function
AdwordsDirect, еще вариант функции в столбце B или кнопки test и повтор для замены в столбце A
[vba]
Код
Function uuu$(t$) Dim t1$ With CreateObject("VBScript.RegExp"): .Pattern = "\w" If .test(t) Then t1 = Application.Proper(.Execute(t)(0)): uuu = .Replace(t, t1) Else uuu = t End With End Function
[/vba]
[vba]
Код
Sub test() Dim z, t$, t1$, i&: z = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Value With CreateObject("VBScript.RegExp"): .Pattern = "\w" For i = 1 To UBound(z): t = z(i, 1) If .test(z(i, 1)) Then t1 = Application.Proper(.Execute(t)(0)): z(i, 1) = .Replace(t, t1) Else z(i, 1) = t Next Range("A1").Resize(UBound(z), UBound(z, 2)).Value = z End With End Sub
[/vba]
AdwordsDirect, еще вариант функции в столбце B или кнопки test и повтор для замены в столбце A
[vba]
Код
Function uuu$(t$) Dim t1$ With CreateObject("VBScript.RegExp"): .Pattern = "\w" If .test(t) Then t1 = Application.Proper(.Execute(t)(0)): uuu = .Replace(t, t1) Else uuu = t End With End Function
[/vba]
[vba]
Код
Sub test() Dim z, t$, t1$, i&: z = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Value With CreateObject("VBScript.RegExp"): .Pattern = "\w" For i = 1 To UBound(z): t = z(i, 1) If .test(z(i, 1)) Then t1 = Application.Proper(.Execute(t)(0)): z(i, 1) = .Replace(t, t1) Else z(i, 1) = t Next Range("A1").Resize(UBound(z), UBound(z, 2)).Value = z End With End Sub
sv2014, Вы отлично знаете регулярки и многие ваши функции на этом форуме у меня вызывали чувство восхищения, но в этой теме Вы упустили условие, что слов может быть больше одного.
sv2014, Вы отлично знаете регулярки и многие ваши функции на этом форуме у меня вызывали чувство восхищения, но в этой теме Вы упустили условие, что слов может быть больше одного.sboy
sboy, благодарю за уточнение,ориентировался на файл-пример создателя темы. Добавил вариант макроса с кнопкой help для любого количества слов для замены в столбце A. Варианты UDF всех,участвовавших в обсуждении очень интересны.
[vba]
Код
Sub help() Dim z, i&: z = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Value With CreateObject("ScriptControl"): .Language = "JScript" .AddCode "function g(t){return t.replace(/\b\w+\b/g,function(t1){return t1.substring(0,1).toUpperCase()+t1.substring(1).toLowerCase();});}" For i = 1 To UBound(z): z(i, 1) = .Run("g", z(i, 1)): Next Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Value = z End With End Sub
[/vba]
sboy, благодарю за уточнение,ориентировался на файл-пример создателя темы. Добавил вариант макроса с кнопкой help для любого количества слов для замены в столбце A. Варианты UDF всех,участвовавших в обсуждении очень интересны.
[vba]
Код
Sub help() Dim z, i&: z = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Value With CreateObject("ScriptControl"): .Language = "JScript" .AddCode "function g(t){return t.replace(/\b\w+\b/g,function(t1){return t1.substring(0,1).toUpperCase()+t1.substring(1).toLowerCase();});}" For i = 1 To UBound(z): z(i, 1) = .Run("g", z(i, 1)): Next Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Value = z End With End Sub
sv2014, Мне просто был интересен вариант на Regexp'е, т.к. начал его изучать. Сам попытался сделать, но получилось очень громоздко в сравнении со штатными функциями VBA.
sv2014, Мне просто был интересен вариант на Regexp'е, т.к. начал его изучать. Сам попытался сделать, но получилось очень громоздко в сравнении со штатными функциями VBA.sboy
sboy, добрый вечер,вот ,например вариант с RegExp функция zzz в столбце J для слов больше одного(думаю можно и короче,стараюсь на любые варианты не тратить больше 5 минут)
[vba]
Код
Function zzz$(t$) Dim t1$, t2$, i&: t2 = t With CreateObject("VBScript.RegExp"): .Pattern = "\b\w+\b" If .test(t2) = False Then zzz = t2 .Pattern = "\b(\w)(\w+)\b": .Global = True For i = 0 To .Execute(t).Count - 1 If .test(t2) Then t1 = .Execute(t)(i).Submatches(0): t = Replace(t, t1, UCase(t1)): zzz = t Next End With End Function
[/vba]
sboy, добрый вечер,вот ,например вариант с RegExp функция zzz в столбце J для слов больше одного(думаю можно и короче,стараюсь на любые варианты не тратить больше 5 минут)
[vba]
Код
Function zzz$(t$) Dim t1$, t2$, i&: t2 = t With CreateObject("VBScript.RegExp"): .Pattern = "\b\w+\b" If .test(t2) = False Then zzz = t2 .Pattern = "\b(\w)(\w+)\b": .Global = True For i = 0 To .Execute(t).Count - 1 If .test(t2) Then t1 = .Execute(t)(i).Submatches(0): t = Replace(t, t1, UCase(t1)): zzz = t Next End With End Function
sboy, добрый вечер,чуть укоротил код функции zzz в столбце N
[vba]
Код
Function zzz1$(t$) Dim t1$, t2$, i&: t2 = t With CreateObject("VBScript.RegExp"): .Pattern = "\b\w+\b": .Global = True If .test(t2) = False Then zzz1 = t2 For i = 0 To .Execute(t).Count - 1: t1 = Left(.Execute(t)(i), 1): t = Replace(t, t1, UCase(t1)): zzz1 = t: Next End With End Function
[/vba] .
sboy, добрый вечер,чуть укоротил код функции zzz в столбце N
[vba]
Код
Function zzz1$(t$) Dim t1$, t2$, i&: t2 = t With CreateObject("VBScript.RegExp"): .Pattern = "\b\w+\b": .Global = True If .test(t2) = False Then zzz1 = t2 For i = 0 To .Execute(t).Count - 1: t1 = Left(.Execute(t)(i), 1): t = Replace(t, t1, UCase(t1)): zzz1 = t: Next End With End Function