excel - 将选定单元格限制在范围内

Question

我正在使用此代码，以便用户一次只能在工作表中选择一个单元格。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Target.Range("A1").Select
    Application.CutCopyMode = False
End Sub

我希望仅将其应用于工作表内的某些 ListObject 范围，例如

Range("table_1[Codes]")
Range("table_2[Names]")
Range("table_3[Cities]")

因此，用户可以自由选择这些 ListObject 范围之外的多个单元格。

Answer 1

只需使用 Application.Intersect method测试 Target在另一个范围内。

If Not Intersect(Target, Me.Range("table_1[Codes]")) Is Nothing _
Or Not Intersect(Target, Me.Range("table_2[Names]")) Is Nothing _
Or Not Intersect(Target, Me.Range("table_3[Cities]")) Is Nothing Then
    Target.Range("A1").Select
    Application.CutCopyMode = False
End If

替代 Or您也可以使用 Union :

If Not Intersect(Target, Union(Me.Range("table_1[Codes]"), Me.Range("table_2[Names]"), Me.Range("table_3[Cities]"))) Is Nothing Then
    Target.Range("A1").Select
    Application.CutCopyMode = False
End If

如果您希望它可以安全地防止列表中的一个表不存在等错误，您必须使用一些错误处理:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim RangeNames() As Variant
    RangeNames = Array("table_1[Codes]", "table_2[Names]", "table_3[Cities]", "this does not exist")

    Dim RangeName As Variant, TestRange As Range
    For Each RangeName In RangeNames
        Set TestRange = Nothing
        On Error Resume Next
        Set TestRange = Intersect(Target, Me.Range(RangeName))
        On Error GoTo 0

        If Not TestRange Is Nothing Then
            Target.Range("A1").Select
            Application.CutCopyMode = False
            Exit For
        End If
    Next RangeName
End Sub

如果其中一个命名表不存在，则此代码仍适用于其他表。