excel - 仅指定非相邻列 VBA 的 INTERSECT 范围

Question

我下面的代码检查当前激活了哪一列，如果它是一个特定的数字，它会做一件事，对于另一列，它会做另一件事，等等。

如果所选列不是我为其编写操作的列之一，我如何强制代码中止？

我只对执行代码感兴趣，例如，如果选择的列号是 10、12、16、18 或列字母是 L、P 或 R。如果是其他任何东西，我想编写代码什么都不做。目前，如果我复制并粘贴到上述列之外的范围内，则激活 Column = 10 时代码中的 msgbox 消息。

Private Sub Worksheet_Change(ByVal Target As Range)


Dim CurrentCell As String
Dim rangeToChange As Range
Dim C As Range, V


' Set rangeToChange = Range("PipelineTable[Status]")
CurrentCell = ActiveCell.Value
Application.EnableEvents = False
On Error Resume Next
'MsgBox "Target Column is " & Target.Column


    If Target.Column = 12 Then
        GoTo AddActivityDate
    End If
    If Target.Column = 16 Then
        GoTo AdvisorNextAction
    End If
   If Target.Column = 18 Then
        GoTo OfficeNextAction
    End If
    If Target.Column = 10 And (Target.Value = "THIS Month – Payment Due") Then
        Range("K" & Target.Row).Value = Range("I" & Target.Row).Value
        Range("I" & Target.Row).Clear
        MsgBox "Moved Commission Due to Month Paid"
    End If
    If Target.Column = 10 And (Target.Value = "Issued But Not Paid") Then
        Range("K" & Target.Row).Value = Range("I" & Target.Row).Value
        Range("I" & Target.Row).Clear
        MsgBox "Moved Commission Due to Month Paid"
    End If
    If Target.Column = 10 And (Target.Value = "Not Going Ahead") Then
        Range("I" & Target.Row).Value = 0
        Range("K" & Target.Row).Value = 0
        MsgBox "Moved ZERO to Initial Commisson and Month Paid"
    End If


AddActivityDate:
    'Update on 11/11/2019 -If data changes in column L Activity , insert
    'today's date into column M - Date of Activity

        Dim WorkRng As Range
        Dim rng As Range
        Dim xOffsetColumn As Integer
        Set WorkRng = Intersect(Application.ActiveSheet.Range("L:L"), Target)
        xOffsetColumn = 1
        If Not WorkRng Is Nothing Then
            Application.EnableEvents = False
            For Each rng In WorkRng
                If Not VBA.IsEmpty(rng.Value) Then
                    rng.Offset(0, xOffsetColumn).Value = Now
                    rng.Offset(0, xOffsetColumn).NumberFormat = "dd/mm/yyyy"
                Else
                    rng.Offset(0, xOffsetColumn).ClearContents
                End If
            Next
            Application.EnableEvents = True
        End If

AdvisorNextAction:
    'Update on 11/11/2019 -If data changes in column L Activity , insert
    'today's date into column M - Date of Activity

        Dim WorkRng2 As Range
        Dim rng2 As Range
        Dim yOffsetColumn As Integer
        Set WorkRng2 = Intersect(Application.ActiveSheet.Range("P:P"), Target)
        yOffsetColumn = 1
        If Not WorkRng2 Is Nothing Then
            Application.EnableEvents = False
            For Each rng2 In WorkRng2
                If Not VBA.IsEmpty(rng2.Value) Then
                    rng2.Offset(0, yOffsetColumn).Value = Now
                    rng2.Offset(0, yOffsetColumn).NumberFormat = "dd/mm/yyyy"
                Else
                    rng2.Offset(0, yOffsetColumn).ClearContents
                End If
            Next
            Application.EnableEvents = True
        End If

OfficeNextAction:
    'Update on 11/11/2019 -If data changes in column L Activity , insert
    'today's date into column M - Date of Activity

        Dim WorkRng3 As Range
        Dim rng3 As Range
        Dim zOffsetColumn As Integer
        Set WorkRng3 = Intersect(Application.ActiveSheet.Range("R:R"), Target)
        zOffsetColumn = 1
        If Not WorkRng3 Is Nothing Then
            Application.EnableEvents = False
            For Each rng3 In WorkRng3
                If Not VBA.IsEmpty(rng3.Value) Then
                    rng3.Offset(0, zOffsetColumn).Value = Now
                    rng3.Offset(0, zOffsetColumn).NumberFormat = "dd/mm/yyyy"
                Else
                    rng3.Offset(0, zOffsetColumn).ClearContents
                End If
            Next
            Application.EnableEvents = True
        End If

     Application.EnableEvents = True
End Sub

标签： excelvbaintersect