依赖下拉列表excel

Question

我的方法我尝试使用名称范围为我的2列。然后转到下一个工作表并创建2列(CountryInput，CitiesInput)。在名为CountryInput的专栏中，我进入数据验证工具以创建第一个下拉列表。CitiesInput列应该依赖于CountryInput是我遇到的问题。我尝试使用indirect=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

如果您可以按照国家和城市对数据进行排序，那么命名范围将是一个更优雅的解决方案。当city的datavalidation公式引用命名范围（例如CITIES）时，您需要根据country的值重置CITIES的范围（使用类似的getCities（）函数的构造）。

下面显示了一种更改命名范围的范围引用的简单方法。可以根据搜索输出更新公式。

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