Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Ограничение диапазона действия макроса"
 
#1
26.07.2022 13:59:50
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Not Intersect(Target, Range("L4:L36;N4:N35;T4:U35;X4:X35;AD4:AD36;AM4:AM36;AQ4:AS36;AW4:AX36;AZ4:AZ36;BC4:BC36")) Is Nothing And Target.Cells.Count = 1 Then
        Application.EnableEvents = False
        newVal = Target
        Application.Undo
        oldval = Target
        If Len(oldval) <> 0 And oldval <> newVal Then
            Target = Target & ";" & newVal
            Else
                Target = newVal
            End If
            If Len(newVal) = 0 Then Target.ClearContents
            Application.EnableEvents = True
        End If
    End Sub
Всем доброго времени суток.

Есть следующая загвоздка.
Есть макрос реализующий возможность вносить в ячейку несколько значений из выпадающего списка.
По идее действие макроса должно ограничиваться указанным диапазоном, однако при попытке изменить значения в ячейка без выпадающего списка, реализует механизм похожий на реализованный в целевых ячейках. То есть проставляет в конце ";" и дублирует измененные данные.

Как скорректировать, чтобы макрос влиял только на целевые ячейки и не дублировал , при повторном выборе, значения из выпадающих списков в целевых ячейках?
Изменено: Юрий М - 26.07.2022 15:08:54
 
 
 
#2
26.07.2022 14:13:08
Майк Файфер,  несколько моментов:
1. Предложите название темы, из которого будет понятна задача - модераторы поменяют.
2. Код следует оформлять соответствующим тегом. Для этого используйте кнопку <...>
3. Ознакомьтесь с правилами: я про максимально допустимый размер файлов. Никому не нужны Ваш рабочие файлы - создавайте небольшие примеры с аналогичной структурой. Ваши файлы удалены.
 
 
 
#3
26.07.2022 14:33:44
1. "Ограничение диапазона действия макроса"
2. Скорректировано
3. Скорректировано
 
 
 
#4
26.07.2022 14:53:18
Попробуйте указать диапазон правильно.
   
Код
If Not Intersect(Target, Range("E:E")) Is Nothing And Target.Cells.Count = 1 Then
 
 
 
#5
26.07.2022 15:20:33
Для файла Пример.xlsm решение помогло.

Попробовал по аналогии применить к целевому файлу, скорректировал диапазон. Не помогло.
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Not Intersect(Target, Range("L:L;N:N;T:T;U:U;X:X;AD:AD;AM:AM;AQ:AQ;AR:AR;AS:AS;AW:AW;AX:AX;AZ:AZ;BC:BC")) Is Nothing And Target.Cells.Count = 1 Then
        Application.EnableEvents = False
        newVal = Target
        Application.Undo
        oldval = Target
        If Len(oldval) <> 0 And oldval <> newVal Then
            Target = Target & ";" & newVal
            Else
                Target = newVal
            End If
            If Len(newVal) = 0 Then Target.ClearContents
            Application.EnableEvents = True
        End If
    End Sub
 
 
 
#6
26.07.2022 15:21:58
Цитата
написал:
Не помогло.
и не поможет, потому что диапазоны надо разделять запятой, а не точкой-с-заптой
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#7
26.07.2022 15:29:20
Да, для ячеек вне требуемого диапазона проблема решена. Однако остается при попытке отредактировать целевые ячейки с выпадающим списком. Получается ситуация, если например, при выборе значений выбрал одно ошибочно, нужно полностью очищать ячейку от данных через DEL. Если пытаюсь скорректировать, удаляя ненужное значение через Backspace, начинает дублировать значение.
 
 
 
#8
08.02.2023 17:14:11
У меня такая же проблема. не могу найти ответа по всем форумам прошелся.  
 
 
 
#9
08.02.2023 18:09:15
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Not Intersect(Target, Range("E")) Is Nothing And Target.Cells.Count = 1 Then
        Application.EnableEvents = False
        If IsEmpty(Target) = False Then 'пропускаем проверку при удалении значения
            newVal = Target
            Application.Undo
            oldVal = Target
            If Len(oldVal) <> 0 And oldVal <> newVal Then
                If InStr(1, oldVal, newVal) = 0 Then
                    Target = Target & ";" & newVal
                End If
            Else
                Target = newVal
            End If
        End If
        Application.EnableEvents = True
    End If
End Sub
Изменено: testuser - 08.02.2023 18:10:19
 
 
 
Страницы: 1
Наверх