Фильтровка данных в ячейке

[Айвенго]

вообщем у меня имеется таблица значений... а так же ячейка где осуществлен выбор этих значений (т.е. при нажатии на ячейку открывается поле со списком) вот... каким образом можно осуществить фильтровку данных в ячейке по некоторому условию... в данном примере хотелось осуществить чтобы ячейка отсеяла все пустые значения которые находятся колонке "свободен"... либо же наоборот оставляла только те записи где есть хоть какое нибудь значение...

[Hugo121]

Возможны варианты. Оба не идеальны, есть что улучшить...

Sub UniqInValidation()
Dim oDict As Object, iLastRow As Long, i As Long, Arr(), kk ', str_ As String
Set oDict = CreateObject("Scripting.Dictionary")
    oDict.CompareMode = vbTextCompare

    With Sheets("Лист1")
        iLastRow = .Cells(Rows.Count, 2).End(xlUp).Row
        For i = 2 To iLastRow
            On Error Resume Next
            oDict.Add .Cells(i, 2), CStr(.Cells(i, 3))
        Next
    ReDim Arr(1 To oDict.Count)
        i = 0
        For Each kk In oDict.keys
       If oDict.Item(kk) <> "" Then
'       str_ = str_ & kk & ","
       i = i + 1
       Arr(i) = kk
       End If
        Next
  '      str_ = Join(Arr, ",")
        Sheets("Лист1").[J1].Validation.Delete
        Sheets("Лист1").[J1].Validation.Add Type:=xlValidateList, Formula1:=Join(Arr, ",") 'str_
    End With
End Sub

[nilem]

А получится сразу Formula1:=Join(.Keys, ",") ?
Ага, получается, только пустые надо сразу отбрасывать, когда oDict.Add

[Hugo121]

И впрямь... Я переделывал из кода на коллекции - с коллекцией не получалось.
Надо добить и сохранить...

[Hugo121]

Sub UniqInValidation()
Dim oDict As Object, iLastRow As Long, i As Long
Set oDict = CreateObject("Scripting.Dictionary")
    oDict.CompareMode = vbTextCompare

    With Sheets("Лист1")
        iLastRow = .Cells(Rows.Count, 2).End(xlUp).Row
        On Error Resume Next
        For i = 2 To iLastRow
                    If Len(.Cells(i, 3)) Then oDict.Add .Cells(i, 2), CStr(.Cells(i, 3))
        Next
        .[J1].Validation.Delete
        .[J1].Validation.Add Type:=xlValidateList, Formula1:=Join(oDict.Keys, ",")
    End With
End Sub

Хотя что-то не выходит уникальность... есть повторы...

Вот кто скажет, почему

Sub WhyNonUniqInValidation()
Dim oDict As Object, iLastRow As Long, i As Long
Set oDict = CreateObject("Scripting.Dictionary")

    With Sheets("Лист1")
        iLastRow = .Cells(Rows.Count, 2).End(xlUp).Row
        For i = 2 To iLastRow
            If Len(.Cells(i, 3)) Then oDict.Add .Cells(i, 2), "1"
        Next
        .[J1].Validation.Delete
        .[J1].Validation.Add Type:=xlValidateList, Formula1:=Join(oDict.keys, ",")
        [n1].Resize(oDict.Count) = Application.Transpose(oDict.keys)
    End With
End Sub

И даже On Error Resume Next убрал - кладёт всё, что ни дашь...

Нашёл - .Value не хватало:

Sub UniqInValidation()
Dim oDict As Object, iLastRow As Long, i As Long
Set oDict = CreateObject("Scripting.Dictionary")

    With Sheets("Лист1")
        iLastRow = .Cells(Rows.Count, 2).End(xlUp).Row
        For i = 2 To iLastRow
            If Len(.Cells(i, 3).Value) Then oDict.Item(.Cells(i, 2).Value) = 1
        Next
        .[J1].Validation.Delete
        .[J1].Validation.Add Type:=xlValidateList, Formula1:=Join(oDict.keys, ",")
    End With
End Sub

[Айвенго]

ммм... а как можно сделать... если имеется вторая таблица значений... и в той же самой ячейке фильтровались данные в зависимости какая таблица выбрана...

[Айвенго]

вот сам документ

[nilem]

В I1 выбираем таблицу.

[Айвенго]

Сообщение от nilem

В I1 выбираем таблицу.

тут как получается то... он выбирает значения из колонки "свободен" и еще откидывает повторяющиеся значения... надо чтоб отображал значения из второй колонки и сверял с третей где есть некое значение
__________________________
хотя нет... все... сам подредактировал