Function up_eng(a As Range) As String Application.Volatile Dim i%, j%, s$ s = a For i = 1 To Len(s) j = Asc(Mid(s, i, 1)) If j > 96 And j < 123 Then Mid(s, i, 1) = Chr(j - 32) Next i up_eng = s End Function
[/vba]
явно можно оптимальнее, а в лоб так: [vba]
Код
Function up_eng(a As Range) As String Application.Volatile Dim i%, j%, s$ s = a For i = 1 To Len(s) j = Asc(Mid(s, i, 1)) If j > 96 And j < 123 Then Mid(s, i, 1) = Chr(j - 32) Next i up_eng = s End Function
Function zz$(t1$) Dim t2$, s$,i& With CreateObject("VBScript.regExp") .Pattern = "\b[a-z]{3}\-[0-9]{3}\b" If .test(t1) Then t2 = .Execute(t1)(0) For i = 1 To Len(t2): s = s & UCase(Mid(t2, i, 1)): Next s = Replace(s, Chr(32), "-") Else zz = t1 End If zz = Left(t1, Len(t1) - Len(t2)) & s End With End Function
[/vba]
21Tuz, добрый день,еще вариант
[vba]
Код
Function zz$(t1$) Dim t2$, s$,i& With CreateObject("VBScript.regExp") .Pattern = "\b[a-z]{3}\-[0-9]{3}\b" If .test(t1) Then t2 = .Execute(t1)(0) For i = 1 To Len(t2): s = s & UCase(Mid(t2, i, 1)): Next s = Replace(s, Chr(32), "-") Else zz = t1 End If zz = Left(t1, Len(t1) - Len(t2)) & s End With End Function
Function TT(text As String) As String Dim arr: arr = Split(text) Dim i As Long With CreateObject("VBScript.Regexp") .Ignorecase = True .Pattern = "[^A-Z\-\.,\d]" For i = 0 To UBound(arr) If Not .test(arr(i)) Then arr(i) = UCase(arr(i)) Next TT = Join(arr) End With End Function
[/vba]
Как-то так[vba]
Код
Function TT(text As String) As String Dim arr: arr = Split(text) Dim i As Long With CreateObject("VBScript.Regexp") .Ignorecase = True .Pattern = "[^A-Z\-\.,\d]" For i = 0 To UBound(arr) If Not .test(arr(i)) Then arr(i) = UCase(arr(i)) Next TT = Join(arr) End With End Function
21Tuz, добрый день еще вариант функции, уважаемый MBT, Ваш вариант переводит все слово Basic в верхний регистр,что не сответствует файл примеру создателя темы, (смотрите файл пример )
[vba]
Код
Function bb$(t1) Dim i&, t2$, s$, m& For i = Len(t1) To 1 Step -1 If Mid(t1, i, 1) Like "[a-z]" Then m = m + 1 If Mid(t1, i, 1) Like "[a-z]" And m = 3 Then t2 = Mid(t1, i, 3): Exit For Else bb = t1 End If Next For i = 1 To Len(t2): s = s & UCase(Mid(t2, i, 1)): Next bb = Replace(t1, t2, s) End Function
[/vba]
21Tuz, добрый день еще вариант функции, уважаемый MBT, Ваш вариант переводит все слово Basic в верхний регистр,что не сответствует файл примеру создателя темы, (смотрите файл пример )
[vba]
Код
Function bb$(t1) Dim i&, t2$, s$, m& For i = Len(t1) To 1 Step -1 If Mid(t1, i, 1) Like "[a-z]" Then m = m + 1 If Mid(t1, i, 1) Like "[a-z]" And m = 3 Then t2 = Mid(t1, i, 3): Exit For Else bb = t1 End If Next For i = 1 To Len(t2): s = s & UCase(Mid(t2, i, 1)): Next bb = Replace(t1, t2, s) End Function
21Tuz, добавлю,что вариант функции up переводит слово Basic целиком в верхний регистр,(приложенный файл,)что не соответствует файл примеру создателя темы. С уважением ко всем участникам обсуждения.
21Tuz, добавлю,что вариант функции up переводит слово Basic целиком в верхний регистр,(приложенный файл,)что не соответствует файл примеру создателя темы. С уважением ко всем участникам обсуждения.sv2014
Function up(s$) As String Dim i% Application.Volatile For i = 1 To Len(s) If Mid(s, i, 1) Like "[a-z]" Then Mid(s, i, 1) = UCase(Mid(s, i, 1)) Next i up = s End Function
[/vba]
Ну вот еще вариант: [vba]
Код
Function up(s$) As String Dim i% Application.Volatile For i = 1 To Len(s) If Mid(s, i, 1) Like "[a-z]" Then Mid(s, i, 1) = UCase(Mid(s, i, 1)) Next i up = s End Function
Function UU(text As String) As String Dim i&, arr: arr = Split(text) For i = 0 To UBound(arr) If arr(i) < "А" Then arr(i) = UCase(arr(i)) Next UU = Join(arr) End Function
[/vba]
Такого кода еще не было [vba]
Код
Function UU(text As String) As String Dim i&, arr: arr = Split(text) For i = 0 To UBound(arr) If arr(i) < "А" Then arr(i) = UCase(arr(i)) Next UU = Join(arr) End Function
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
