依赖下拉列表excel

Question

我有一个关于如何创建基于上一列的下拉列的问题。我正在努力解决的是我的数据是如何结构的。

我的第一列 A 包含所有国家/地区名称。该列的标题名为 Country。第二列（B 列）包含所有城市名称。该列的标题名为 Cities。我希望能够选择一个国家/地区，然后下一列应该只显示该国家/地区的城市供我选择。

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

如果您可以按国家和城市对数据进行排序，那么命名范围将是一个更优雅的解决方案。 然后，城市的数据验证公式将引用一个命名范围，例如城市 您需要根据国家/地区的值重置 CITIES 的范围（使用类似的 getCities() 函数构造。

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

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