Профессиональные приемы работы в Microsoft Excel

Обмен опытом => Microsoft Excel => Тема начата: Kaamm Ammkk от 03.10.2016, 10:09

Название: Разные действия при изменении в двух диапазонах столбцов
Отправлено: Kaamm Ammkk от 03.10.2016, 10:09
Здравствуйте.
Помогите пожалуйста: Имеется следующий макрос:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim objCell As Range

With Target
If .Column < 1 Or .Column > 5 Or .Row < 1 Or .Row > 100000000 Then Exit Sub
End With

For Each objCell In Target
If TypeName(objCell.Value) = "String" Then
objCell.Value = Left(objCell.Value, 10)
End If

Next
End Sub


Он реагирует на изменение в ячейках диапазона <1 или >5. И призначении больше 10 - режет  значение до 10. Каким образом мне добавить данную проверку на нескольких столбцах?
Т. е. нужно что то вроде:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim objCell As Range

With Target
If .Column < 1 Or .Column > 5 Or .Row < 1 Or .Row > 100000000 Then Exit Sub
End With

For Each objCell In Target
If TypeName(objCell.Value) = "String" Then
objCell.Value = Left(objCell.Value, 10)
End If

With Target
If .Column < 7 Or .Column > 9 Or .Row < 1 Or .Row > 100000000 Then Exit Sub
End With

For Each objCell In Target
If TypeName(objCell.Value) = "String" Then
objCell.Value = Left(objCell.Value, 4)
End If

Next
End Sub


Но при этом ругается. Помогите пожалуйста.
Название: Re: Несколько функций на изменение значения.
Отправлено: vikttur от 03.10.2016, 11:27
Где Вы видели столбец или строку с номером меньше 1? )
Зачем указывать ограничение на строку? Ваши недоброжелатели могут вносить данные ниже миллионной строки?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim objCell As Range
    With Target
        If .Column > 9 Or .Row > 100000000 Then Exit Sub

        For Each objCell In Target
            If TypeName(objCell.Value) = "String" Then
                If .Column < 6 Then
                    bjCell.Value = Left(objCell.Value, 10)
                Else
                    bjCell.Value = Left(objCell.Value, 4)
                End If
            End If
        Next
    End With
End Sub


Ограничение на столбцы можно наложить так:
If Not Application.Intersect(Range("A:H"), Target) Is Nothing Then
...
End If
Название: Re: Несколько функций на изменение значения.
Отправлено: Kaamm Ammkk от 03.10.2016, 11:38
Private Sub Worksheet_Change(ByVal Target As Range)
Dim objCell As Range

With Target
If .Column < 1 Or .Column > 5 Or .Row < 1 Or .Row > 100000000 Then Exit Sub
End With

For Each objCell In Target
If TypeName(objCell.Value) = "String" Then
objCell.Value = Left(objCell.Value, 10)
End If

Next
End Sub

Так работает правильно - ограничение накладывается на строки 1-5 в 10 символов.

Предложите свой вариант, который бы проверял несколько столбцов на одну длину, другие несколько столбцов на другую длину. Никак не получается - уже 3-тий день с этим мучаюсь.
Спасибо заранее
Название: Re: Несколько функций на изменение значения.
Отправлено: vikttur от 03.10.2016, 11:50
1. Зачем продублировали код?
2. Вы код из моего сообщения применяли?
Название: Re: Несколько функций на изменение значения.
Отправлено: Kaamm Ammkk от 03.10.2016, 12:42
Напишите пожалуйста маленький рабочий пример:
Проверка на длину 1-го столбца - 10 символов - иначе чтобы отрезал остальные, 5-го столбца на 5 символов - при попытке записи большего количества - отрезалось чтобы. Данные могут быть любые - символьные и цифровые.

Спасибо. Ваш код - не сработал - выходит ошибка 242
Название: Re: Несколько функций на изменение значения.
Отправлено: vikttur от 03.10.2016, 12:51
Нет уж. Это Вы покажите маленький пример с неработающим кодом.  Ведь свой код я писал "на коленке" - некуда вставить.
Название: Re: Несколько функций на изменение значения.
Отправлено: Kaamm Ammkk от 03.10.2016, 12:55
На верху же я показал - две части - в отдельности работают, но вместе никак не состыкую.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim objCell As Range

With Target
If .Column < 1 Or .Column > 5 Or .Row < 1 Or .Row > 100000000 Then Exit Sub
End With

For Each objCell In Target
If TypeName(objCell.Value) = "String" Then
objCell.Value = Left(objCell.Value, 10)
End If

With Target
If .Column < 7 Or .Column > 9 Or .Row < 1 Or .Row > 100000000 Then Exit Sub
End With

For Each objCell In Target
If TypeName(objCell.Value) = "String" Then
objCell.Value = Left(objCell.Value, 4)
End If

Next
End Sub

А вот так работает

Private Sub Worksheet_Change(ByVal Target As Range)
Dim objCell As Range

With Target
If .Column < 1 Or .Column > 5 Or .Row < 1 Or .Row > 100000000 Then Exit Sub
End With

For Each objCell In Target
If TypeName(objCell.Value) = "String" Then
objCell.Value = Left(objCell.Value, 10)
End If

Next
End Sub

От 1-5 столбца проверяет. При записи строки выше 10 символов в эти столбцы, обрезает до 10 символов.

Нужно чтобы например 6-7 столбы проверялось там же на значение не привышающее 5 символов.

Спасибо заранее.
Название: Re: Несколько функций на изменение значения.
Отправлено: vikttur от 03.10.2016, 13:23
Я точно так же, как и Вы, вставил код в сообщение...
Цитироватьсвой код я писал "на коленке" - некуда вставить.
Пример - это файл  Excel, в который вставлен код и показана ошибка.
Неужели Вы считаете, что для помощи Вам все должны прилагать максимум усилий, но только не  Вы? Помогающие должны создать файл, вбить туда данные, вставить макрос... Кому это надо?

Зачем по несколько раз копировать одинаковый код? Вы создаете мусор в теме.
Макросы в сообщении нужно оформлять тэгами кода (для этого есть кнопка)