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
Всем доброго времени суток.
Есть следующая загвоздка. Есть макрос реализующий возможность вносить в ячейку несколько значений из выпадающего списка. По идее действие макроса должно ограничиваться указанным диапазоном, однако при попытке изменить значения в ячейка без выпадающего списка, реализует механизм похожий на реализованный в целевых ячейках. То есть проставляет в конце ";" и дублирует измененные данные.
Как скорректировать, чтобы макрос влиял только на целевые ячейки и не дублировал , при повторном выборе, значения из выпадающих списков в целевых ячейках?
Майк Файфер, несколько моментов: 1. Предложите название темы, из которого будет понятна задача - модераторы поменяют. 2. Код следует оформлять соответствующим тегом. Для этого используйте кнопку <...> 3. Ознакомьтесь с правилами: я про максимально допустимый размер файлов. Никому не нужны Ваш рабочие файлы - создавайте небольшие примеры с аналогичной структурой. Ваши файлы удалены.
Попробовал по аналогии применить к целевому файлу, скорректировал диапазон. Не помогло.
Код
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
Да, для ячеек вне требуемого диапазона проблема решена. Однако остается при попытке отредактировать целевые ячейки с выпадающим списком. Получается ситуация, если например, при выборе значений выбрал одно ошибочно, нужно полностью очищать ячейку от данных через DEL. Если пытаюсь скорректировать, удаляя ненужное значение через Backspace, начинает дублировать значение.
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