Здравствуйте, уважаемые форумчане. Столкнулся с следующей проблемой в данном файле на листе "лист1" столбец А был заполнен формулами(=ЕСЛИ(СЧЁТЗ('Участок № 491 БД'!C3);ТЕКСТ('Участок № 491 БД'!C3;"ММММ ГГГГ");"")) до конца, а потом с помощью удалить дубликаты оставались только уникальные значения. Так вот еще вчера все работало как надо, но почему-то сегодня данный столбец ( а нужен он для динамического списка) перестал работать как надо, функция мгновенное заполнение не хочет работать ни в каком виде (двойной клик по крестику или через работу с данными). Файл по каким-то непонятным причинам раздуло до размеров в 5 мегабайт, по этому делюсь им через гугл диск https://drive.google.com/open?id=1nt1TxQjJQPdts5o8ljGdjilgnrY9Jlz-
FastPuppy написал: столбец А был заполнен формулами..... до конца
Т.е. до последней, до 1 048 576 строки? А это точно необходимо? Удалил в Вашем файле на Листе1 эти неиспользуемые строки. Размер 22 Кб. И все автозаполняется
До последний не обязательно конечно, но без столбца, который сначала выдергивает месяц из колонки даты на листе БД, а потом создает аналогичный без повторений месяца, у меня не получится создать динамический список на листе Участок №491. К слову почему-то расширенный фильтр с проблемой справиться не помогает, выдавая ошибку "ссылка". Короче я худо бедно смог решить задачу взяв макрос (вроде даже с вашего сайта)
Код
Function Уник(ByVal ra As Range) As Variant On Error Resume Next: Dim cell As Range, coll As New Collection, txt$ For Each cell In ra.Cells txt$ = Trim(cell): If Len(txt$) Then coll.Add txt$, txt$ Next cell ReDim newarr(1 To coll.Count, 1 To 1) For i = 1 To coll.Count: newarr(i, 1) = coll(i): Next i Уник = newarr End Function
Попробовал написать свой макрос на копирование уникальных ячеек до тех пор пока не появится пустая ячейка, но чет напортачил
Код
Sub Test2() ' ActiveSheet.Cells(1, 4).Select i = 1 Do Until IsEmpty(ActiveCell) If ActiveCell.Value = ActiveCell.Offset(1, 0).Value Then ActiveCell.Offset(1, 0).Select Else Selection.Copy ActiveSheet.cell(i, 1) i = i + 1 End If ActiveCell.Offset(1, 0).Select Loop End Sub