Суть: Ячейка A1 в которой X символов, например 51. Нужно, что бы в ячейку B2 было обрезано первые слова до 33 символов, в C1 слова, что не вошли в B2. Как это реализовать?
Пример:
Ячейка A1 (49 символов): купить пухлого розового слона в интернет магазине
Ячейка B1 (31 символ), что важно - без пробела в конце: купить пухлого розового слона в
Ячейка C1 (17 символов), что важно - без пробела в начале интернет магазине
Буду благодарен за эти 2 формулы в ячейках B1 и C1
Суть: Ячейка A1 в которой X символов, например 51. Нужно, что бы в ячейку B2 было обрезано первые слова до 33 символов, в C1 слова, что не вошли в B2. Как это реализовать?
Пример:
Ячейка A1 (49 символов): купить пухлого розового слона в интернет магазине
Ячейка B1 (31 символ), что важно - без пробела в конце: купить пухлого розового слона в
Ячейка C1 (17 символов), что важно - без пробела в начале интернет магазине
Буду благодарен за эти 2 формулы в ячейках B1 и C1
Если символов в исходной ячейке меньше 33, то выскакивает ошибка. Как сделать, что бы в таком случае отображались это значение до 33, а справа ничего?goloburdov
Вот, когда-то делал, но тестировал поверхностно[vba]
Код
Function TrimText(text As String, Count As Long, Optional TrimComma As Boolean = True, Optional SpaceComma As String) As String ' 'Функция возвращает подстроку состоящую из целых слов, суммарная длина которой не превышает заданное значениче 'Обязательный аргумент Text - исходная сторока 'Обязательный аргумент Count - максимальное количество символов, составляющих подстроку 'Необязательный аргумент TrimComma - если истина с конца подстроки удаляются пробел и следующие символы: ,\-=;№#@:+({<[_ 'Необязательный аргумент SpaceComma - введенная без разделителей строка с сисмволами, которые в любом случае 'будут отделены от предыдущего символа пробелом
Dim Obj As Object Dim I As Long With CreateObject("VBScript.RegExp") .Pattern = "\s" If .test(text) Then text = .Replace(text, " ") If SpaceComma <> "" Then .Pattern = "[" & SpaceComma & "]" Set Obj = .Execute(text) For I = 0 To Obj.Count - 1 text = .Replace(text, " " & Obj.Item(I)) Next End If .Pattern = " {2,}" If .test(text) Then text = .Replace(text, " ") If Len(text) <= Count Then TrimText = text Exit Function End If .Pattern = "^.{1," & Count & "} " If .test(text) Then text = .Execute(text)(0) If TrimComma Then .Pattern = "[,\-=;№#@:\+({<\[_ ]+$" Else .Pattern = " $" If .test(text) Then text = .Replace(text, "") TrimText = text End With End Function
[/vba]
Вот, когда-то делал, но тестировал поверхностно[vba]
Код
Function TrimText(text As String, Count As Long, Optional TrimComma As Boolean = True, Optional SpaceComma As String) As String ' 'Функция возвращает подстроку состоящую из целых слов, суммарная длина которой не превышает заданное значениче 'Обязательный аргумент Text - исходная сторока 'Обязательный аргумент Count - максимальное количество символов, составляющих подстроку 'Необязательный аргумент TrimComma - если истина с конца подстроки удаляются пробел и следующие символы: ,\-=;№#@:+({<[_ 'Необязательный аргумент SpaceComma - введенная без разделителей строка с сисмволами, которые в любом случае 'будут отделены от предыдущего символа пробелом
Dim Obj As Object Dim I As Long With CreateObject("VBScript.RegExp") .Pattern = "\s" If .test(text) Then text = .Replace(text, " ") If SpaceComma <> "" Then .Pattern = "[" & SpaceComma & "]" Set Obj = .Execute(text) For I = 0 To Obj.Count - 1 text = .Replace(text, " " & Obj.Item(I)) Next End If .Pattern = " {2,}" If .test(text) Then text = .Replace(text, " ") If Len(text) <= Count Then TrimText = text Exit Function End If .Pattern = "^.{1," & Count & "} " If .test(text) Then text = .Execute(text)(0) If TrimComma Then .Pattern = "[,\-=;№#@:\+({<\[_ ]+$" Else .Pattern = " $" If .test(text) Then text = .Replace(text, "") TrimText = text End With End Function