Question

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

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

我的方法我尝试在我的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"

从属下拉列表Excel

1 个答案: