Диапазон INTERSECT только для указанных несмежных столбцов VBA - PullRequest
Новая
       43

Диапазон INTERSECT только для указанных несмежных столбцов VBA

0 голосов
/ 29 января 2020

My c ode ниже проверяет, какой столбец активирован в данный момент, и если это заданное число c, то он выполняет одно действие, для другого столбца - другое, et c.

Как я могу принудительно прервать выполнение кода, если выбранный столбец не является одним из столбцов, для которых у меня записаны действия?

Меня интересует только выполнение кода, например, если номер столбца выбрано 10, 12, 16, 18 или столбец Буква L, P или R. Если это что-то еще, я хочу, чтобы код ничего не делал. В настоящий момент, если я копирую и вставляю диапазоны вне указанных выше столбцов, сообщения msgbox внутри кода, когда столбец = 10, активируются. 

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