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

Пожалуйста, войдите или зарегистрируйтесь.


Расширенный поиск  

Новости:

Теперь на форум можно залогиниться / зарегистрироваться с помощью ВКонтакте. Уже существующие пользователи могут связать свою учетную запись с аккаунтом ВКонтакте одним кликом в профиле пользователя http://forum.msexcel.ru/index.php?action=profile;area=account

Автор Тема: Разные действия при изменении в двух диапазонах столбцов  (Прочитано 603 раз)

0 Пользователей и 1 Гость просматривают эту тему.

Kaamm Ammkk

  • Новичок
  • *
  • Уважение: +0/-0
  • Оффлайн Оффлайн
  • Сообщений: 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

 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

Но при этом ругается. Помогите пожалуйста.
« Последнее редактирование: 03.10.2016, 14:23:34 от vikttur »
Записан

vikttur

  • Глобальный модератор
  • Ветеран
  • *****
  • Уважение: +50/-0
  • Оффлайн Оффлайн
  • Сообщений: 1 015

Где Вы видели столбец или строку с номером меньше 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
« Последнее редактирование: 03.10.2016, 11:52:33 от vikttur »
Записан

Kaamm Ammkk

  • Новичок
  • *
  • Уважение: +0/-0
  • Оффлайн Оффлайн
  • Сообщений: 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

 Next
End Sub

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

Предложите свой вариант, который бы проверял несколько столбцов на одну длину, другие несколько столбцов на другую длину. Никак не получается - уже 3-тий день с этим мучаюсь.
Спасибо заранее
« Последнее редактирование: 03.10.2016, 11:46:39 от Kaamm Ammkk »
Записан

vikttur

  • Глобальный модератор
  • Ветеран
  • *****
  • Уважение: +50/-0
  • Оффлайн Оффлайн
  • Сообщений: 1 015

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

Kaamm Ammkk

  • Новичок
  • *
  • Уважение: +0/-0
  • Оффлайн Оффлайн
  • Сообщений: 6

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

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

vikttur

  • Глобальный модератор
  • Ветеран
  • *****
  • Уважение: +50/-0
  • Оффлайн Оффлайн
  • Сообщений: 1 015

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

Kaamm Ammkk

  • Новичок
  • *
  • Уважение: +0/-0
  • Оффлайн Оффлайн
  • Сообщений: 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 символов.

Спасибо заранее.
« Последнее редактирование: 03.10.2016, 13:18:48 от Kaamm Ammkk »
Записан

vikttur

  • Глобальный модератор
  • Ветеран
  • *****
  • Уважение: +50/-0
  • Оффлайн Оффлайн
  • Сообщений: 1 015

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

Зачем по несколько раз копировать одинаковый код? Вы создаете мусор в теме.
Макросы в сообщении нужно офорОйть тэгами кода (для этого есть кнопка)
« Последнее редактирование: 03.10.2016, 13:43:42 от vikttur »
Записан
 



Темы без ответов

24.01.2020 14:03 На диаграмме Ганта несоответствие оси Y 210
09.08.2019 14:09 Макрос для заполнения таблиц через форму 1889
18.07.2019 16:02 Рассылка почты из Excel при помощи почтовой программы TheBAT! 1568
09.07.2019 20:39 Кредит с уменьшением периода выплат 1695
28.05.2019 21:09 Сделать несколько скриптов для рабочей таблицы 2242
05.03.2019 17:00 Последовательный вывод таблиц Excel в один документ Word без шаблона 2366
05.03.2019 09:29 Нежелательные изменение размеров колонтитула при редактировании 2100
07.02.2019 01:36 Как удалить дубликаты из выпадающего связанного списка? 2168
20.01.2019 12:38 Все варианты частичного суммирования 2324
13.01.2019 12:24 Заполнение диапазона числами - в виде кластеров 2098





Яндекс цитирования msexcel.ru Яндекс.Метрика

Страница сгенерирована за 0.17 секунд. Запросов: 111.