помогите поправить макрос

[tem1112]

ПОМОГИТЕ

В ячейках последовательность кодов они разделены между собой " - " (пробел дефис пробел) нужно оставлять в ячейке только 65 символов при этом строка всегда будет оканчиваться на "- " (дефис пробел), (т.к. коды имеют одинаковую длину), а остальные будут переноситься ниже, во вновь созданную строку, где опять будет проверяться условие на 65 символов. Но в коде может встречаться текст (21 символ) делить его нельзя, и если при этом условие 65 символов будет дробить этот текст, то нужно перенести его ниже во вновь созданную строку, ячейку снизу. и при этом проверить чтобы последними символами в этой строке были "- " (дефис пробел)(в такой последовательности), если это не так сдвигаться влево пока это условие не выполнится, далее переносы и осуществлять также.

Есть макрос

Sub jurnal()
l = 1
s = Worksheets("Лист1").Cells(l, 4).Value
While Len(s) > 0
s = Worksheets("Лист1").Cells(l, 4).Value
If Len(s) > 65 Then
Worksheets("Лист1").Cells(l, 4).Value = Left(s, 65)
Worksheets("Лист1").Rows(l + 1).Insert
Worksheets("Лист1").Cells(l + 1, 4).Value = Right(s, Len(s) - 65)
End If
l = l + 1
Wend
End Sub

как его поправить чтобы он работал так же, но при достижении в тексте определенного фрагмента (в 21 символ), который нельзя разделить и если этот фрагмент не укладывается в условие 65 символов в ячейке, то происходит перенос на новую ячейку снизу и дальше все также но в этой строке (с неделимым текстом) в любом случае нужно проверить если последние два символа в этой строке не "- " (дефис, пробел)(именно в такой последовательности), то необходимо смещаться влево до тех пор пока последними не станут эти символы, и перенос на новую ячейку снизу, далее все также.

Заранее благодарен.

[doober]

На текст бы посмотреть,не совсем понятно.

[tem1112]

текст примерно такой

123-4-5678 - 987-0-4793 - аа ааааааааа аааааааа - 757-8-4377 - 576-8-8643 - 768-9-6499 - 969-9-8642

неделимый текст в 21 символ везде одинаковый. но может встречаться в ячейке не один раз.

[doober]

Если условие в 65 символов не выполняется,то в ячейке может при определенных условиях остатся близкое к 65 ,только не более 65
Я правильно понял?

[tem1112]

да, но не должна делиться фраза в 21 символ и сам код, т. е. оканчиваться строка долнжа примерно так:


111-1-1111 - 111-1-1111- 111-1-1111 - 111-1-1111- 111-1-1111-
111-1-1111 - аа ааааааааа аааааааа - 111-1-1111 -
111-1-1111 - 111-1-1111- 111-1-1111 - 111-1-1111- 111-1-1111-


во вторую строку еще один код (10символов) не влезет поэтому нужен перенос. срока не должна начинаться с пробела или с дефиса.

[SAS888]

Вы бы лучше прикрепили файл с примером исходных строк (все возможные варианты) и примером требуемого результата. Давно получили бы нужный ответ. Иначе, к Вам будет еще "куча" уточняющих вопросов.

[doober]

В левую руку взял хрустальный шар,поговорил с ним ,и написал
такой код.
Для проверки заполняю ячейку,уберете лишнее

Sub шрустальный_шар()
Dim rezult, s As String
Dim limit, dlinna, l As Integer
Dim ls, d

l = 1
' --------------------------------------------------------

'Выделенное красным убрать
s = "111-1-1111 - 111-1-1111- 111-1-1111 - 111-1-1111- 111-1-1111- 111-1-1111 -" & _
" аа ааааааааа аааааааа - 111-1-1111 -111-1-1111 - 111-1-1111-" & _
" 111-1-1111 - 111-1-1111- 111-1-1111- 123-4-5678 - 987-0-4793 - " & _
"аа ааааааааа аааааааа - 757-8-4377 - 576-8-8643 - 969-9-8642 - " & _
"аа ааааааааа аааааааа - 757-8-4377 - 576-8-8643 - 768-9-6499 - 969-9-8642"
'---------------------------------------------------------------------
Worksheets("Лист1").Cells(l, 4).Value = s
s = ""

s = Worksheets("Лист1").Cells(l, 4).Value

d = Replace(s, "- ", Chr(7))

ls = Split(d, Chr(7), -1)

For n = 0 To UBound(ls)
dlinna = Len(ls(n)) + 2
If n = UBound(ls) Then

Cells(l, 4).Value = rezult

Exit For
End If
If limit + Len(ls(n + 1)) + 2 > 65 Then


Cells(l, 4).Value = rezult
l = l + 1
rezult = ""
limit = 0
Else
rezult = rezult & ls(n) & "- "

limit = limit + dlinna
End If

Next

End Sub

[tem1112]

Спасибо, попробую