Sub Список()
Dim il As Long, i As Long, x As Integer
Dim arr()
    Sheets(2).Columns(1).Clear
    If Cells(2, 5).Value = "Тема1" Then x = 1 'Номер столбца
    If Cells(2, 5).Value = "Тема2" Then x = 2
        il = Cells(Rows.Count, x).End(xlUp).Row
        With CreateObject("Scripting.Dictionary")
            For i = 2 To il
                If Not .exists(Cells(i, x).Value) Then .Add Key:=Cells(i, x).Value, Item:=""
            Next i
       arr = Application.Transpose(.keys)
       End With
       Set r = Sheets(2).Cells(1).Resize(UBound(arr), 1)
            r.Value = arr
    Cells(2, 7).Validation.Delete
    Cells(2, 7).Validation.Add Type:=xlValidateList, Formula1:="=" & Sheets(2).Name & "!" & r.Address
End Sub

Cells(2, 7).Validation.Add Type:=xlValidateList, Formula1:="=" & Sheets(2).Name & "!" & r.Address

    Cells(2, 7).Validation.Add Type:=xlValidateList, Formula1:="='" & Sheets(2).Name & "'!" & r.Address(, , Application.ReferenceStyle)

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address(0, 0) <> "E2" Then Exit Sub
    Select Case Target.Value
        Case "Тема1"
            c_ = 1
        Case "Тема2"
            c_ = 2
        Case Else
            Exit Sub
    End Select
    r1_ = Cells(Rows.Count, c_).End(xlUp).Row - 1
    ar = Cells(2, c_).Resize(r1_)
    Set slov = CreateObject("Scripting.Dictionary")
    With slov
        For i = 1 To r1_
            If Not IsEmpty(ar(i, 1)) Then
                aaa = .Item(CStr(ar(i, 1)))
            End If
        Next i
        Sheets(2).Columns(1).ClearContents
        Sheets(2).Cells(1).Resize(.Count) = Application.Transpose(.Keys)
        ActiveWorkbook.Names.Add Name:="spis", RefersTo:="=Лист2!$A$1:$A$" & .Count
    End With
End Sub

uniq.Add Replace(Cells(i, x), ",", "."), CStr(Cells(i, x))