Зависимый выпадающий список Excel

Question

У меня есть вопрос о том, как создать раскрывающийся столбец на основе предыдущего столбца.С чем я борюсь, так это как мои данные структурированы.

В моем первом столбце A указаны все названия стран.Заголовок этого столбца называется Страна.Второй столбец (столбец B) содержит все названия городов.Заголовок этого столбца называется Cities.Я хочу иметь возможность выбрать страну, и тогда в следующем столбце должны отображаться только города для этой страны.

Мой подход Я пытаюсь использовать диапазон имен для своих 2 столбцов.Затем я перехожу на следующий лист и создаю 2 столбца (CountryInput, CitiesInput).В столбце с именем CountryInput я иду в инструменты проверки данных, чтобы создать первый раскрывающийся список.У меня возникла проблема с столбцом CitiesInput, который должен зависеть от CountryInput.Я пытался использовать косвенную функцию = A2, но ничего не происходит.

Также я могу использовать vba или макрос для этого?

Answer 1

Да, для этого можно использовать VBA. Однако именованные диапазоны возможны только в том случае, если вы собираетесь использовать страны и города как непрерывный список, то есть все строки, отсортированные по странам и городам в указанном порядке. Приведенный ниже код позволит вам создать эту функцию независимо от порядка сортировки, т. Е. Даже если данные не отсортированы. Это основной код, написанный не для производительности, но работающий, пожалуйста, отредактируйте его соответствующим образом. Надеюсь, что это решит вашу проблему.

Sub SetupCountry() 'run this on workbook open event
    Dim rng As Range
    Set rng = ActiveSheet.Range("H7")  'choose your cell(s) here
    With rng.Validation
        FRM = GetUniqueCountries()
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=FRM
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End Sub

Sub SetupCity()  'run this sub on the change event of Country cell
    Dim rng As Range
    Set rng = ActiveSheet.Range("I7")  'choose your cell(s) here
    With rng.Validation
        FRM = GetCities()
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=FRM
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End Sub


Function GetUniqueCountries() As String
    Dim sOut As String
    Dim v, c
    Dim rngList As Range

    Set rngList = ActiveSheet.Range("D7:D28") 'edit the range where your country list is stored
    sOut = ""

    For Each c In rngList
        If InStr(1, sOut, c.Value & ",") = 0 Then  'check if the value is already in the upload list and add if not there
            sOut = c.Value & "," & sOut
        End If
    Next c
    'remove first ,
    If sOut <> "" Then
        sOut = Left(sOut, Len(sOut) - 1)
    End If
    GetUniqueCountries = sOut
End Function
Function GetCities() As String
     Dim sOut As String
    Dim v, c
    Dim rngSearch As Range

    Set rngSearch = ActiveSheet.Range("D7:D28") 'edit the range where your cities list exists
    sOut = ""

    For Each c In rngSearch
        If c.Value = ActiveSheet.Range("H7").Value Then 'selected country
            sOut = sOut & "," & ActiveSheet.Range("E" & c.Row).Value
        End If
    Next c
    'remove first ,
    If sOut <> "" Then
        sOut = Mid(sOut, 2)
    End If
    GetCities = sOut
End Function

Если вы в порядке, сортируя данные по стране и городам, то именованные диапазоны будут более элегантным решением. Где тогда формула подтверждения данных для города будет ссылаться на именованный диапазон, например ГОРОДА вам нужно будет сбросить диапазон для CITIES на основе значения страны (используя аналогичную конструкцию функции getCities ().

Один простой способ изменить ссылку на диапазон для именованного диапазона показан ниже. Формула может быть обновлена ​​на основе результатов поиска.

ActiveWorkbook.Names("SOMENAMEDRANGE").RefersTo = "=Sheet1!$D$5:$L$25"