Страницы: 1
RSS
Вставить в ячейку значения, отличные от выпадающего списка
 
Доброго времени суток, господа

Подскажите, существует ли решение такого вот вопроса: Есть таблица ячейки которой заполняются с помощью выпадающего списка, данный для которого берутся на соседнем листе, возможно ли вставлять в таблице не тот текст что выпадает непосредственно в списке, а из соседней ячейки таблицы с данными для него?
На примере в списке выбираем цвет, он же и вставляется в ячейку, возможно ли вставить его код, но при этом чтобы в списке по прежнему был цвет?
 
Алексей Чуйкин, т.е. выбирая из выпадающего списка цвет вы хотите просто закрашивать ее. но при это что бы ячейка оставалась пустой??
Не бойтесь совершенства. Вам его не достичь.
 
Mershik, нет, хотелось бы чтобы при выборе цвета в ячейке отражался его код, для красного - 101, для синего - 102 и т.д., при этом в самом списке отражались бы названия цветов, для наглядности
 
Алексей Чуйкин, в модуль листа
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("A2:i20")) Is Nothing Then
Set myfind = Worksheets("Лист2").Columns(2).Find(Target.Value, LookIn:=xlValues)
On Error Resume Next
Range(Target.Address) = myfind.Offset(0, -1)
End If
End Sub
Не бойтесь совершенства. Вам его не достичь.
 
Mershik, спасибо огромное, все работает, сейчас попытаюсь прикрутить в основную большую таблицу
 
Mershik, в примере работает, в моей таблице отказывается.

Вставляю ваш код
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("AE4:AX253")) Is Nothing Then
Set myfind = Worksheets("Данные").Columns(8).Find(Target.Value, LookIn:=xlValues)
On Error Resume Next
Range(Target.Address) = myfind.Offset(0, -1)
End If
End Sub

с заменой на свои диапазоны и название листа и оно не работает.
Подскажите пожалуйста что я сделал не так
 
Алексей Чуйкин, нужен файл хотя бы в реальной структуре что бы глянуть..
Не бойтесь совершенства. Вам его не достичь.
 
Mershik, он большого размера, из-за ограничений не могу выложить на форум, может быть можно вам куда-то его отправить?
 
Алексей Чуйкин,
Цитата
Алексей Чуйкин написал:
в реальной структуре
т.е. можете удалить все данные и все оставить только то что касается кода.
кстати возможно вы макрос не в тот модуль листа вставили...
Изменено: Mershik - 05.04.2020 12:14:28
Не бойтесь совершенства. Вам его не достичь.
 
Mershik, сократил таблицу, оставил только два листа, которые касаются ввода.

На листе "Расчет материала" интересуют столбцы с АЕ по АХ, сейчас оставил 6 строк, а вообще их 250. На  листе "Данные" столбцы G и H, из них формируется выпадающий список. Сейчас в списке данные из столбца G, в выпадающем списке нужно их заменить на данные столбца Н, это не проблема, но на листе "Расчет материала" по прежнему должны отображаться коды из столбца G, потому что на них завязаны другие таблицы.

P.S. Если возможно, нужно изменить ширину выпадающего списка, чтобы в строке списка умещалось больше данных, при этом не изменяя ширины ячейки на листе "Расчет материала"
 
Алексей Чуйкин,
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("AE4:AX9")) Is Nothing Then ' указываете ваш диапазон где при изменении будет происходить замена нужного вам значения
Set myfind = Worksheets("Данные").Columns(7).Find(Target.Value, LookIn:=xlValues) ' указываете номер столбца где ищем нужное нам значение из выпадающего списка
On Error Resume Next
Range(Target.Address) = myfind.Offset(0, 1)  ' 0 - смещение по строкам, 1 смещение по столбцам относительно значения выбранного из списка

End If
End Sub
Изменено: Mershik - 05.04.2020 12:52:25
Не бойтесь совершенства. Вам его не достичь.
 
Алексей Чуйкин, если вопрос задан еще на другом форуме нужно давать ссылку.
Кросс
Алексей М.
 
Mershik, я вроде тоже самое менял в коде, не хотел он работать, сейчас, после небольшой замены данных, работает на ура, за исключением одного момента - при удалении данных из ячейки клавишей DEL, макрос крашится
 
АlехМ, прощу прощения, исправлюсь
 
Алексей Чуйкин,
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("AE4:AX9")) Is Nothing Then
If IsEmpty(Target) Then Exit Sub
Set myfind = Worksheets("Данные").Columns(.Find(Target.Value, LookIn:=xlValues)
On Error Resume Next
Range(Target.Address) = myfind.Offset(0, -1)
End If
End Sub
Не бойтесь совершенства. Вам его не достичь.
 
Mershik, АlехМ, спасибо огромное. Разобрался. Вот такой получился код
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("AE4:AX253")) Is Nothing Then
If IsEmpty(Target) Then Exit Sub
Set myfind = Worksheets("Данные").Columns(8).Find(Target.Value, LookIn:=xlValues)
On Error Resume Next
Range(Target.Address) = myfind.Offset(0, -1)
End If
End Sub
Работает.

Подскажите, можно как-то по простому изменить ширину выпадающего списка, чтобы в нем мои длинные названия умещались?  
Изменено: Алексей Чуйкин - 05.04.2020 13:36:45
 
Алексей Чуйкин, создайте отдельно тему или посмотрите по форуму...
Изменено: Mershik - 05.04.2020 13:43:16
Не бойтесь совершенства. Вам его не достичь.
Страницы: 1
Наверх