Question

目标：在以下情况下触发两个单独的worksheet_change(ByVal Target as Range)宏以复制数据并将其粘贴到不同的标签中：

列J范围=“已关闭”；和
以任何方式编辑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“最佳实践”技巧可以减少此代码。如果您能将这些技巧与可能的解决方法一起传递，我将不胜感激！

仅当删除单元格输入时触发worksheet_change事件

0 个答案: