Question

我目前有一个看起来像这样的表：

  |   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 |       |           |            |

在第二个表中，我已将数据验证应用于State和City列，引用第一个表中的数据。所以我列出了所有州和城市的名单。

我希望能够做的是，如果用户在州列中输入“NSW”，则城市列中的选项列表将被过滤以仅显示位于新南威尔士州的城市

Answer 1

将其放在Worksheet的代码模块中。

更改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

Excel筛选数据验证列表基于单元格内容

1 个答案: