В серое поле нужно внести список "Позиций" из таблицы (столбец D:D) с сортировкой по номеру (столбец E:E). Положение поля со списком может меняться - это учитывает имя Data_List. Положение таблицы может меняться, а список строк дополняться - это учитывает дин. диапазон Data. Названия позиций и их номера могут меняться, также номера могут содержать пустоты ("") - список должен перестроиться с исключением пустот.
так как проверка данных в данном случае работает только с диапазоном листа, даже если он динамический, то на листе нужно формировать упорядоченный список и уже его использовать.
БМВ, разве нельзя создать сортированный список DATA макросом? Макрос повесить на событие обращения к именованной ячейке со списком...
Вот пример макроса создания списка в ячейке DATA_List без сортировки:
Код
Sub Macro2()
Dim i As Long
ReDim Arr(1 To Range("DATA").Rows.Count)
For i = 1 To Range("DATA").Rows.Count
Arr(i) = Range("DATA").Rows(i)
Next
[DATA_List].Validation.Delete
[DATA_List].Validation.Add Type:=xlValidateList, Formula1:=Join(Arr, ",")
End Sub
Простите, не заметил и с ходу не понял. Вроде работает. Реально ли убрать доп. столбец и восстановить ранее созданный динамический диапазон, чтобы данные добавлялись в список автоматически?
Acid Burn, Знакома ли Вам эта статья? Выпадающий список с быстрым поиском Если вместо исключения лишних данных организовать их сортировку во вспомогательном диапазоне, то должно получиться именно то, что КМК Вам требуется...
IKor, статью видел, но вроде на мою задачу не очень похоже. И опять же используется доп. столбец, либо функции Фильтр и Сорт, которой нет в старых версиях Excel.
Acid Burn, SQL Запросом можно получить и список и отсортировать и поместить в проверку данных. вопрос только зачем? У вас закончились скрытые листы куда можно положить доп. столбец?
БМВ, файл мега-здоровенный. Нужно какое-то простое и компактное решение. Вот что-то похожее на макросах. Можно адаптировать под мою задачу? Или как-то доработать Ваш пример под динамический диапазон?
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count = 1 And Target.Address = "$E$3" Then
Set cn = CreateObject("ADODB.Connection")
Set cmd = CreateObject("ADODB.Command")
Set rs = CreateObject("ADODB.Recordset")
cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ActiveWorkbook.FullName & ";" & _
"Extended Properties=""Excel 8.0;HDR=NO"";"
cn.Open
cmd.ActiveConnection = cn
cmd.CommandText = "SELECT F2 FROM [Лист1$B2:C65536] Where F1 Is Not Null order by F1 ASC"
rs.Open cmd
Do Until rs.EOF
StrList = StrList & "," & rs.Fields("F2").Value
rs.movenext
Loop
Target.Validation.Delete
Target.Validation.Add Type:=xlValidateList, Formula1:=StrList
rs.Close
End If
End Sub
Acid Burn написал: И опять же используется доп. столбец,
Цитата
БМВ написал: на листе нужно формировать упорядоченный список и уже его использовать
Так Вас устраивает дополнительный столбец или нет? Сделайте его на отдельном листе и присвойте ему имя, которое используете в качестве источника данных для проверки-данных...
IKor, всё же решение БМВ мне больше нравится - никаких доп. столбцов, красота.
БМВ, спасибо, в Вашем файле всё работает! Но есть проблема - данные расположились несколько иначе и списков будет несколько. Понимаю, что в коде Test.xlsm надо поправить 3 строки, но не понимаю, как поправить... (
'=============================================================================================
' ДИНАМИЧЕСКИЙ ВЫПАДАЮЩИЙ СПИСОК С СОРТИРОВКОЙ ПО КРИТЕРИЮ
' https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=121761&MID=1007509
'=============================================================================================
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
''If Target.Count = 1 And Target.Address = "$E$3" Then
If Target.Count = 1 And Target.Address = [Data_List].Address Then ' тут сравниваем адреса а не значения
Set cn = CreateObject("ADODB.Connection")
Set cmd = CreateObject("ADODB.Command")
Set rs = CreateObject("ADODB.Recordset")
cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ActiveWorkbook.FullName & ";" & _
"Extended Properties=""Excel 8.0;HDR=NO"";"
cn.Open
cmd.ActiveConnection = cn
'' cmd.CommandText = "SELECT F2 FROM [Лист1$B2:C65536] Where F1 Is Not Null order by F1 ASC"
cmd.CommandText = "SELECT F1 FROM [Лист1$j6:k65536] Where F2 Is Not Null order by F2 ASC" ' тут меняется порядок полей F1 , F2 и диапазон. Так как имена не заданы
rs.Open cmd
Do Until rs.EOF
'' StrList = StrList & "," & rs.Fields("G11").Value
StrList = StrList & "," & rs.Fields("F1").Value ' ну и тут тепер берется первое поле
rs.movenext
Loop
Target.Validation.Delete
Target.Validation.Add Type:=xlValidateList, Formula1:=StrList
rs.Close
End If
End Sub
БМВ, теперь понятно всё, кроме того, как заменить Лист1$j6:k65536 на динамический диапазон. Ну, чтобы спокойно перемещать таблицу вверх-вниз-влево-вправо и забивать данные, не задумываясь. Простите, сам понимаю, что вопросы идиотские, жёстко туплю после работы...
Задал имя Data = Лист1!$J$6:ИНДЕКС(Лист1!$J$6:$XFD$1048576;СЧЁТЗ(Лист1!$J$6:$J$1048576);СЧЁТЗ(Лист1!$J$6:$XFD$6)), но cmd.CommandText = "SELECT F1 FROM [Data].Address (и FROM [Data]) не взлетает.
А должно? Изучите range.address , там 5 параметров, вам нужно 3 из них, и кажется еще убрать имя книги. + заменить ! на $ ну и конечно вставлять корректно.
Описание Range.Address не помогло. Сейчас динамический диапазон включает всю таблицу. И состоит из неволатильных функций. Нужно как-то извернуться (через СМЕЩ или ДВССЫЛ) и оставить только 2 столбца или что?
Я ж не знаю что у вас там с диапазоном, да и зачем его делать динамическим? Преобразовать примернро так,
Код
cmd.CommandText = "SELECT F1 FROM [" & _
Replace(Replace(Replace(Range("data").Address(False, False, , True), "!", "$"), "[" & ThisWorkbook.Name & "]", ""), "'", "") & _
"] Where F2 Is Not Null order by F2 ASC"
rs.Open cmd
ну уж ладно =Лист1!$J$6:INDEX(Лист1!$K$6:$K$1048576;COUNTA(Лист1!$J$6:$J$1048576);1) кстати дома на 2016 пришлось менять провайдера на Provider=Microsoft.Ace.OLEDB.12.0
БМВ, вариант cmd.CommandText из поста #23 сработал и с моим дин. диапазоном, Jet.OLEDB.4.0 на Office 2019 тоже работает. Но Ваш вариант компактнее и продвинутее, оставлю его в качестве финального. Спасибо огромное!
Возможно, в строке 24362 символов и 1183 значений. Срезал до 8000 прошло на 9000 уже сбой. Но и глупо иметь такой выпадающий список. Что из него без поиска можно выбрать? Просто надо перейти на Combobox c фильтром, при этом добавить в запрос Where F2 Is Not Null AND F1 Like "'%" & cmb.value &"%'" и будет фильтровать по найденным по событию ввода в комбо.
БМВ, понятно, пост был для информации о существовании лимита: по моим подсчётам 8189 символов. По факту в списке будет не более 100 позиций, но не факт, что в длину они не превысят лимит... Поэтому, если сделаете вариант Combobox c фильтром, буду благодарен!