Добрый день. Есть макрос (спасибо krosav4ig) - он обрезает текстовую строку до нужной длинны по концу последнего слова, удаляя при этом хвосты менее 3х символов.
Задача: иногда в конце строки он оставляет пробел, и стандартной функцией СЖПРОБЕЛЫ - он не убирается. Что надо дописать в нем, что бы в конце строки он не оставлял пробела?
[vba]
Код
Function dd$(str$, lim&) Dim arr(), i&, n&, k& str = Application.Trim(str) ReDim arr(i) arr(i) = Len(Split(str, " ")(i)) n = arr(i) + 1 Do Until i = UBound(Split(str, " ")) k = Len(Split(str, " ")(i + 1)) If n + k > lim Then Exit Do i = i + 1: ReDim Preserve arr(i) arr(i) = k: n = n + k + 1 Loop Do Until arr(i) > 3 Or Len(str) <= lim n = n - 1 - arr(i) i = i - 1 Loop dd = Left(str, n) End Function
[/vba] [moder]Оформляйте коды тегами, кнопка #[/moder]
Добрый день. Есть макрос (спасибо krosav4ig) - он обрезает текстовую строку до нужной длинны по концу последнего слова, удаляя при этом хвосты менее 3х символов.
Задача: иногда в конце строки он оставляет пробел, и стандартной функцией СЖПРОБЕЛЫ - он не убирается. Что надо дописать в нем, что бы в конце строки он не оставлял пробела?
[vba]
Код
Function dd$(str$, lim&) Dim arr(), i&, n&, k& str = Application.Trim(str) ReDim arr(i) arr(i) = Len(Split(str, " ")(i)) n = arr(i) + 1 Do Until i = UBound(Split(str, " ")) k = Len(Split(str, " ")(i + 1)) If n + k > lim Then Exit Do i = i + 1: ReDim Preserve arr(i) arr(i) = k: n = n + k + 1 Loop Do Until arr(i) > 3 Or Len(str) <= lim n = n - 1 - arr(i) i = i - 1 Loop dd = Left(str, n) End Function
[/vba] [moder]Оформляйте коды тегами, кнопка #[/moder]scaels1
Предлагаю свою UDF с математикой попроще. Протестируйте. Первый аргумент - текст, второй - сколько резать.
[vba]
Код
Function Rio_Cut(StrX As String, SzeX As Long) As String
Dim A As Integer, B As Byte Rio_Cut = Left(StrX, SzeX)
For A = SzeX To 1 Step -1 If Mid(Rio_Cut, A, 1) <> " " Then B = B + 1 If B > 2 Then Exit For Else Select Case B Case 0, 1, 2: Rio_Cut = Left(Rio_Cut, A - 1): B = 0 Case Else: Exit For End Select End If Next A
End Function
[/vba]
scaels1, здравствуйте.
Предлагаю свою UDF с математикой попроще. Протестируйте. Первый аргумент - текст, второй - сколько резать.
[vba]
Код
Function Rio_Cut(StrX As String, SzeX As Long) As String
Dim A As Integer, B As Byte Rio_Cut = Left(StrX, SzeX)
For A = SzeX To 1 Step -1 If Mid(Rio_Cut, A, 1) <> " " Then B = B + 1 If B > 2 Then Exit For Else Select Case B Case 0, 1, 2: Rio_Cut = Left(Rio_Cut, A - 1): B = 0 Case Else: Exit For End Select End If Next A
Хвост менее трех символов - это обрубки слов из одной или двух букв. Следовательно, обрубки из трёх и более букв можно оставить. Так работала моя логика, что могло пойти не так? =)
Хвост менее трех символов - это обрубки слов из одной или двух букв. Следовательно, обрубки из трёх и более букв можно оставить. Так работала моя логика, что могло пойти не так? =)Rioran
Роман, Москва, voronov_rv@mail.ru Яндекс-Деньги: 41001312674279
scaels1, а посмотрите, как у Вас будет работать моя же функция с лёгкой доработкой? На правах спортивного азарта.
[vba]
Код
Function Rio_Cut(StrX As String, SzeX As Long) As String
Dim A As Integer, B As Byte Rio_Cut = StrX
For A = Len(StrX) To 1 Step -1 If Mid(Rio_Cut, A, 1) <> " " Then B = B + 1 Else If A + B > SzeX And A <= SzeX Then Rio_Cut = Left(Rio_Cut, A - 1) ElseIf A <= SzeX And B < 3 Then Rio_Cut = Left(Rio_Cut, A - 1) ElseIf A + B <= SzeX And B > 2 Then Rio_Cut = Left(Rio_Cut, A + B) Exit For End If B = 0 End If Next A
End Function
[/vba]
scaels1, а посмотрите, как у Вас будет работать моя же функция с лёгкой доработкой? На правах спортивного азарта.
[vba]
Код
Function Rio_Cut(StrX As String, SzeX As Long) As String
Dim A As Integer, B As Byte Rio_Cut = StrX
For A = Len(StrX) To 1 Step -1 If Mid(Rio_Cut, A, 1) <> " " Then B = B + 1 Else If A + B > SzeX And A <= SzeX Then Rio_Cut = Left(Rio_Cut, A - 1) ElseIf A <= SzeX And B < 3 Then Rio_Cut = Left(Rio_Cut, A - 1) ElseIf A + B <= SzeX And B > 2 Then Rio_Cut = Left(Rio_Cut, A + B) Exit For End If B = 0 End If Next A
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
