Событие worksheet_change срабатывает только при удалении ввода ячейки - PullRequest
0 голосов
/ 01 ноября 2018

Цель: вызвать два отдельных макроса worksheet_change(ByVal Target as Range) для копирования данных и вставки в разные вкладки, когда:

  1. столбец J range = "Закрыто"; и
  2. диапазон столбца G редактируется любым способом.

VBA ниже, кажется, работает для (1). Но (2), по-видимому, запускает макрос, только когда данные ячейки столбца G удалены вместо input .

Option Explicit

Private Sub worksheet_change(ByVal target As Range)

    'Declare variables
    Dim CompletionDate As String
    Dim MsgGP As String
    Dim TitleMsg As String
    Dim CompletionComments As String
    Dim MsgGP2 As String
    Dim TitleMsg2 As String
    Dim RevisedDate As String
    Dim RevisedComments As String
    Dim MsgGP3 As String
    Dim TitleMsg3 As String

    TitleMsg = "xx"                              'Define InputBox text strings
    MsgGP = "xx"
    TitleMsg2 = "Road to $$"
    MsgGP2 = "xx"
    TitleMsg3 = "Task Deferral"
    MsgGP3 = "Deferral due to:"

    If Not Application.Intersect(target, Range("J" & ActiveCell.Row)) Is Nothing And InStr(1, Range("J" & ActiveCell.Row), "Closed") > 0 Then

        'If column J has changed and equals closed


        CompletionDate = Application.InputBox(MsgGP, TitleMsg, FormatDateTime(Date, vbShortDate), Type:=1) 'Create Input box to enter completion date

        If CompletionDate = "False" Then Exit Sub

        CompletionComments = Application.InputBox(MsgGP2, TitleMsg2, Type:=0) 'Create Input box to enter completion comments

        If CompletionComments = "False" Then Exit Sub

        Sheets("Plan").Range("B" & ActiveCell.Row & ":H" & ActiveCell.Row).Copy 'Copy columns B to H

        Sheets("Closed").Select                  'Select other worksheet

        Sheets("Closed").Range("i" & Rows.Count).End(xlUp).Offset(1) = CompletionDate 'Enter completion date

        Sheets("Closed").Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues 'Paste work task data

        Sheets("Closed").Range("j" & Rows.Count).End(xlUp).Offset(1) = CompletionComments 'Paste completion comments

        Sheets("Plan").Activate                  'Open Plan worksheet

        Sheets("Plan").Range("D" & ActiveCell.Row & ":AV" & ActiveCell.Row).ClearContents 'Clear Contents in selected row

        Sheets("Plan").Activate                  'Open Plan worksheet

    End If

    If Not Intersect(target, target.Worksheet.Range("G" & ActiveCell.Row)) Is Nothing Then

        RevisedComments = Application.InputBox(MsgGP3, TitleMsg3, Type:=0) 'Create Input box to enter completion comments
        If RevisedComments = "False" Then Exit Sub

        Sheets("Plan").Range("B" & ActiveCell.Row - 1 & ":H" & ActiveCell.Row - 1).Copy 'Copy columns B to H

        Sheets("Revised").Select                 'Select other worksheet

        Sheets("Revised").Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues 'Paste work task data

        Sheets("Revised").Range("j" & Rows.Count).End(xlUp).Offset(1) = RevisedComments 'Paste completion comments

        Sheets("Plan").Activate                  'Open Plan worksheet
    End If

End Sub

Я уверен, что есть много полезных советов VBA по сокращению этого кода. Я был бы признателен, если бы вы могли передать эти советы вместе с потенциальным решением!

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...