автоматически сокращать длину текста

[floriak]

Как сделать так чтобы, посмле копирования в ячейку текста (более 50 символов текста) автоматически в ячейку вносилились только первые 50. Или обрезался текст до 50 символов. Незнаю как правильно ето назвать.

Например есть текст в 70 символов. Мы его копируем в ячейку, а в ячейку попадает только первые 50?
Зарание благодарен.

[Казанский]

Если сделать для одного листа - в код листа (правый клик на ярлычке листа - Исходный текст):

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
On Error Resume Next
For Each c In Target.SpecialCells(xlCellTypeConstants, xlTextValues)
    If Len(c) > 50 Then c = Left(c, 50)
Next
End Sub

Если для всей книги, то в код объекта "ЭтаКнига" (ThisWorkbook):

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim c As Range
On Error Resume Next
For Each c In Target.SpecialCells(xlCellTypeConstants, xlTextValues)
    If Len(c) > 50 Then c = Left(c, 50)
Next
End Sub

[VictorM]

в В1=ЛЕВСИМВ(A1; 50)

[floriak]

Спасибо!
Только у меня получаеться на листе три столбца в одном нужно ограничить 50ю во втором 200 а в третьем 100. чтоб типа автоматом обрезало текст вставленый до определённого количества символов

[floriak]

можно ли применить ето к конкретному столбцу? и если да то как? Спасибо!

[Казанский]

на листе три столбца в одном нужно ограничить 50ю во втором 200 а в третьем 100
Сразу об этом нельзя было написать?
Вот - не оптимально, но с минимальными изменениями.
Как и предыдущий вариант, работает при дновременном изменении многих ячеек.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim c As Range, l&
On Error Resume Next
For Each c In Intersect(Target.SpecialCells(xlCellTypeConstants, xlTextValues), Sh.Range("A:C"))
    l = Choose(c.Column, 50, 200, 100)
    If Len(c) > l Then c = Left(c, l)
Next
End Sub

[floriak]

Спасибо! только почему то не получилось(((

Может так лутше будет обьяснить.
Колонка А ограничена 50
Колонка В ограничена 200
Колонка Е ограничена 100

Чтоб срабатывало обрезание на данном количестве символов!
пРОСТИТЕ ЧАЙНИКА)))

[Казанский]

Это мой последний пост в теме

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim c As Range, l&
On Error Resume Next
For Each c In Intersect(Target.SpecialCells(xlCellTypeConstants, xlTextValues), Sh.Range("A:B,E:E"))
    l = Choose(c.Column, 50, 200, , , 100)
    If Len(c) > l Then c = Left(c, l)
Next
End Sub