Новости:

Новая редакция правил форума: 2.4. Если вопрос или ответ содержится во вложенном файле, все-равно кратко описывайте в сообщении вопрос или суть решения. Это необходимо, чтобы тему можно было найти через поиск.

Главное меню

Разные действия при изменении в двух диапазонах столбцов

Автор Kaamm Ammkk, 03.10.2016, 10:09

« назад - далее »

Kaamm Ammkk

Здравствуйте.
Помогите пожалуйста: Имеется следующий макрос:
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


Но при этом ругается. Помогите пожалуйста.

vikttur

#1
Где Вы видели столбец или строку с номером меньше 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

Kaamm Ammkk

#2
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-тий день с этим мучаюсь.
Спасибо заранее

vikttur

1. Зачем продублировали код?
2. Вы код из моего сообщения применяли?

Kaamm Ammkk

Напишите пожалуйста маленький рабочий пример:
Проверка на длину 1-го столбца - 10 символов - иначе чтобы отрезал остальные, 5-го столбца на 5 символов - при попытке записи большего количества - отрезалось чтобы. Данные могут быть любые - символьные и цифровые.

Спасибо. Ваш код - не сработал - выходит ошибка 242

vikttur

Нет уж. Это Вы покажите маленький пример с неработающим кодом.  Ведь свой код я писал "на коленке" - некуда вставить.

Kaamm Ammkk

#6
На верху же я показал - две части - в отдельности работают, но вместе никак не состыкую.

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 символов.

Спасибо заранее.

vikttur

#7
Я точно так же, как и Вы, вставил код в сообщение...
Цитироватьсвой код я писал "на коленке" - некуда вставить.
Пример - это файл  Excel, в который вставлен код и показана ошибка.
Неужели Вы считаете, что для помощи Вам все должны прилагать максимум усилий, но только не  Вы? Помогающие должны создать файл, вбить туда данные, вставить макрос... Кому это надо?

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