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

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

将所选单元格限制在范围内

1 个答案: