從屬下拉列表Excel

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，則您需要根據國家/地區的值重置CITIES的范圍（使用類似getCities（）函數的構造。

下面顯示了一種更改命名范圍的范圍參考的簡單方法。 可以根據搜索結果更新公式。

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