Excel根据单元格内容过滤了数据validation列表
我目前有一张如下所示的表格:
| A | B | +-------+-----------+ 1 | State | City | +=======+===========+ 2 | NSW | Goulburn | 3 | NSW | Sydney | 4 | VIC | Melbourne | 5 | VIC | Horsham | 6 | NSW | Tamworth |
然后我有另外一张桌子,看起来像这样:
| A | B | C | +-------+-----------+------------+ 1 | State | City | Other data | +=======+===========+============+ 2 | | | |
在第二个表中,我已经将数据validation应用于State和City列,并引用了第一个表中的数据。 所以我列出了所有州和城市的名单。
我想要做的是,如果用户在州列中input“NSW”,城市列中的选项列表将被过滤,以仅显示位于新南威尔士州的城市
将其放置在工作表的代码模块中。
更改shTable
的定义以引用查找表所在的工作表。
Private Sub Worksheet_Change(ByVal Target As Range) Dim myVal As String Dim cityList As String Dim table As Range Dim cl As Range Dim shTable As Worksheet: Set shTable = Sheets("Index") '<modify as needed' If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub myVal = Target.Value With shTable Set table = .Range("A2", .Range("A2").End(xlDown)) 'contains your city/state table' End With For Each cl In table 'Build a comma-separated list of matching cities in the state.' If cl.Value = myVal Then If cityList = vbNullString Then cityList = cl.Offset(0, 1) Else: If InStr(1, cityList, cl.Offset(0,1).Value, vbBinaryCompare) > 0 Then 'avoid duplicates, but this is not a foolproof method.' 'probably should rewrite using an array or scripting dictionary' 'otherwise the possibility of partial match is a potential error.' cityList = cityList & "," & cl.Offset(0, 1) End If End If End If Next 'Now, with the cell next to the changed cell, remove ' ' any existing validation, then add new validation ' ' based on the cityList we compiled above. With Target.Offset(0, 1).Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:=cityList .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .ShowInput = True .ShowError = True End With End Sub