Страницы: 1
RSS
Отфильтрованные данные с другого листа в выпадающем списке
 
Уважаемые знатоки! Снова обращаюсь к вам за помощью, т.к. сама бьюсь с этим вопросом уже 2 дня, но никак не получается добиться желаемого результата. Вроде и похожие темы есть, но всё-равно не то что нужно.
Ситуация такая: есть файл, и в поле этого файла необходимо макросом создать выпадающий список с данными одного столбца из другой книги (там будут наименования гибридов), но дело в том, что в выпадающем списке должны быть только уникальные не повторяющиеся значения, а в столбце с гибридами много повторений.   :o

Я себе представляю что это должно быть так: открывается файл с данными, уникальные наименования из столбца записываются в массив (циклом) проверяя, если еще такого значения нет в массиве, а затем этот массив передается в выпадающий список уже моей книги. Но дело в том, что с массивами еще не работала, и попытки мои не увенчались пока успехом. Хочу попросить помощи - может есть уже похожая тема, но я ее не нашла, или принцип где-то описан похожий, либо я вообще неправильно представляю реализацию и подскажете как-то по другому? Заранее большое спасибо за помощь, надежда только на ваши советы  :)  :)  :)
 
Цитата
Ангелина Ткаченко пишет: ... но дело в том, что в выпадающем списке должны быть только уникальные не повторяющиеся значения, а в столбце с гибридами много повторений...
Кто или что мешает на отдельном листе создать динамичный список уникальных?
Приемы - ВС в другом файле - http://www.planetaexcel.ru/techniques/1/37/ ... ;)
"Ctrl+S" - достойное завершение ваших гениальных мыслей!.. ;)
 
Мешает то, что список будет постоянно обновляться, и подобных файлов будет очень много, алгоритм нужен один на все файлы, их пишу не для себя, а для пользователей, которые просто не будут обновлять динамические списки на другом листе(((

И основная проблема что это выпадающее поле должно создаваться именно макросом, т.к. оно будет протягиваться на количество заполненных смежных строк
Изменено: Ангелина Ткаченко - 27.07.2013 10:30:26
 
Кто хочет, тот ищет возможности, кто не хочет — ищет причины ... ;)
Познакомились - выборка уникальных, динамические/именованные диапазоны, списки/ таблицы?
"Ctrl+S" - достойное завершение ваших гениальных мыслей!.. ;)
 
Файлы в которые вставляла прицепила, но попытки сохранения в массив убрала, так как там у меня получился бред((
Изменено: Ангелина Ткаченко - 27.07.2013 10:31:11
 
Цитата
Z пишет: ...выборка уникальных, динамические/именованные диапазоны, списки/ таблицы?
Честно, не очень поняла, вы имеет ввиду, что мне массивы не нужны? Мне хотя бы подскажите что искать, пожалуйста
 
Мне представляется важным - не связывать файлы.
Лучше макросом (файл №1):
1. открывать файл(ы) №2, заполняя динамический(е) массив(ы),
2. "унифицировать" эти массивы в новые (с уникальными названиями).
Эта часть макроса достаточно тривиальна.
Изменено: Мотя - 26.07.2013 09:44:31
 
Cм. почту.
 
ZVI выкладывал решения по формированию уникальных для ComboBox. Посмотрите, может подойдет. тут только и надо передать функции диапазон из файла.
 
Цитата
Igor67 пишет:
ZVI выкладывал решения по формированию уникальных для ComboBox. Посмотрите, может подойдет. тут только и надо передать функции диапазон из файла.
Спасибо, только мне немного не подходит, мне не комбобокс нужен, а выпадающий список в ячейку.

Вроде уникальные значения из столбца удалось получить, но почему-то не заполняется ValidationList... Может какая-то ошибка у меня, а я не понимаю?

Тут записываются уникальные значения в массив newarr из другого файла
Код
arr = Range(Cells(5, 2), Cells(iLastRow, 2)).Value
 On Error Resume Next: Dim coll As New Collection, txt$
 For i = LBound(arr) To UBound(arr)
 txt$ = Trim(arr(i, 1)): coll.Add txt$, txt$
 Next i
 ReDim newarr(1 To coll.Count, 1 To 1)
 For i = 1 To coll.Count: newarr(i, 1) = coll(i): Next i
 UniqueValuesFromArray = newarr

Далее хочу сделать выпадающий список

Код
With Cells(r, 6)
 .HorizontalAlignment = xlCenter
 With Cells(r, 6).Validation
 .Delete
 .Add Type:=xlValidateList, Formula1:=Join(newarr, ",") 
 
 .InputTitle = ""
 .ErrorTitle = ""
 .InputMessage = ""
 .ErrorMessage = ""
 .ShowInput = True
 .ShowError = True
 End With
 End With

но никакого выпадающего списка нет(((
Изменено: Ангелина Ткаченко - 29.07.2013 14:04:03
 
Так попробуйте:
Код
.Add Type:=xlValidateList, Formula1:=Join(newarr, ",")
 
У меня так и было, видно когда копировала опечалась как-то. Не помогает( В чем может быть дело?  :(
 
Покажите простейший файл-пример с неработающим кодом.
 
Файлы прикрепила. Сначала нужно открывать файл 1. затем в нем нажимать кнопку "Создать список", и выбирать файл с гибридами. Столбец F должен заполняться выпадающим списком в каждой строке, но не заполняется(((
 
Вариант.
 
Полагаю, это - часть Вашей задачи.
Если файлов, требующих вставки выпадающих списков, много, то задачу следует решать иным способом: с "автоматическим" считыванием этих файлов...
Ну, и т. д...
Кстати, в реальном примере результат сортировки наименований гибридов будет выглядеть абсолютно нормально.
В Вашем примере неудачный список наименований гибридов - "сквозная" нумерация начинается с 1.
Следовало бы с 01 (001...).
Изменено: Мотя - 29.07.2013 16:49:47
 
Спасибо большое, всё работает! Файлов действительно будет много, но смысл в том, что каждый раз человеку необходимо будет самому решать в каком случае, из какого файла тянуть гибриды. И заполняться будет выпадающий список не во всем столбце, а лишь в некоторых строках, где будет выполняться соответствующее условие. Но самое главное что мне просто перечисление гибридов не нужно, как у меня в примере (я это сделала для наглядности проверки - заполнился массив уникальными значениями), а нужен только выпадающий список, поэтому мне файл не совсем подошел, т.к. насколько я поняла там идет заполнение данных из именованного диапазона.

Не понимаю в чем у меня ошибка в коде - так столбец D заполняется уникальными значениями массива.
Код
Range("D1").Resize(UBound(newarr)).Value = newarr 
но почему не хочет делать выпадающий список с данными из массива?
Код
With Cells(r, 6)
        .HorizontalAlignment = xlCenter
 With Cells(r, 6).Validation
        .Delete
.Add Type:=xlValidateList, Formula1:=Join(newarr, ",") 'должен быть выпадающий список из массива newarr
       
       
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
     End With

Изменено: Ангелина Ткаченко - 29.07.2013 21:06:03
 
Если Вы хотите получить реальную помощь, показывайте реальную проблему.
 
Проблема в том что не могу массив newarr передать в выпадающий список. Ничего не происходит, файлы прикрепляла)

Код
 arr = Range(Cells(5, 2), Cells(iLastRow, 2)).Value
 On Error Resume Next: Dim coll As New Collection, txt$
 For i = LBound(arr) To UBound(arr)
 txt$ = Trim(arr(i, 1)): coll.Add txt$, txt$
 Next i
 ReDim newarr(1 To coll.Count, 1 To 1)
 For i = 1 To coll.Count: newarr(i, 1) = coll(i): Next i
 UniqueValuesFromArray = newarr
 
Если Вы имеете навыки в написании макросов, зачем Вам чужой код и "геморрой", связанный с разгадкой замысла его автора? ;)
Ведь макрос - это "программа на 1-ой ножке"!
Есть макрорекордер и "не паханные возможности" параметризации его, макрорекордера, кода.
 
Цитата
Мотя пишет: Ведь макрос - это "программа на 1-ой ножке"!
Есть макрорекордер и "не паханные возможности" параметризации его, макрорекордера, кода.
Да в том и дело что у меня практически нет навыков, мне просто нужно это сделать очень, а не получается и я не понимаю почему, уже пол интернета обыскала.
 
Думаю потому, что массив двумерный.
Попробуйте примерно так:
Код
Sub tt()
a = [a1:a5].Value
s = Join(Application.Transpose(a), ",")
End Sub

Вернее сразу заполняйте одномерный массив, или даже сразу делайте строку.
Но если строка будет длинной - открыть файл с таким списком не получится (сохранить даст)  :(
Изменено: Hugo - 29.07.2013 21:07:15
 
Цитата
Hugo пишет: Но если строка будет длинной - открыть файл с таким списком не получится (сохранить даст)  :(  
Точно из-за двумерного массива! Передалала немного заполнения массива и вроде получилось!))))))
Код
arr = Range(Cells(5, 2), Cells(iLastRow, 2)).Value
  On Error Resume Next: Dim coll As New Collection, txt$
 For i = LBound(arr) To UBound(arr)
  txt$ = Trim(arr(i, 1)): coll.Add txt$, txt$
    Next i
    ReDim newarr(1 To coll.Count)
    For i = 1 To coll.Count: newarr(i) = coll(i): Next i
    UniqueValuesFromArray = newarr

Огромное спасибо за наводку, я уже с ума сходила
Изменено: Ангелина Ткаченко - 29.07.2013 21:07:37
Страницы: 1
Читают тему
Наверх