Worksheet_SelectionChange - 別の列のタイムスタンプ

Question

私は、以下のコードを使用して、仕事をCompletedに変更すると、従業員の優先順位リストにタイムスタンプを付けています。コードはうまく動作しますが、変更を追跡したいセルごとに複製する必要があります。

理想的には、私はコードに全く同じ機能を持たせて圧縮したいので、範囲M5:M2500、セルM250をCompletedに変更した場合は、Y5:Y500を参照して、セルにY250というタイムスタンプを貼り付けます。

うまくいけば、これは意味があり、どんな提案もありがとう！

Private Sub Worksheet_Change(ByVal Target As Range) 

    If Target.Address = "$M$5" Then 
    Call Complete5 
    End If 
    If Target.Address = "$M$6" Then 
    Call Complete6 
    End If 


    End Sub 

    Sub Complete5() 
    ActiveSheet.Unprotect Password:="unlock" 
    If InStr(1, Range("$M$5"), "Completed") > 0 Then 
     Range("$Y$5").Select 
     ActiveCell.FormulaR1C1 = "=NOW()" 
     ActiveCell.Select 
     Selection.Copy 
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
      :=False, Transpose:=False 
     Application.CutCopyMode = False 
     Range("$M$5").Select 
    Else 
     Range("$Y$5").Select 
     ActiveCell.ClearContents 
     Range("$M$5").Select 
    End If 
    End Sub 
    Sub Complete6() 
    ActiveSheet.Unprotect Password:="unlock" 
    If InStr(1, Range("$M$6"), "Completed") > 0 Then 
     Range("$Y$6").Select 
     ActiveCell.FormulaR1C1 = "=NOW()" 
     ActiveCell.Select 
     Selection.Copy 
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
      :=False, Transpose:=False 
     Application.CutCopyMode = False 
     Range("$M$6").Select 
    Else 
     Range("$Y$6").Select 
     ActiveCell.ClearContents 
     Range("$M$6").Select 
    End If 
End Sub 

Answer 1

これは、Worksheet_Changeイベント自体の中で非常にきれいに行うことができます。このコードは、変更されたMの行を評価し、それに応じてYの対応する行を修正し、ユーザーが複数の行を同時に完了（Ctrl + Enter）した場合にも機能します。 警告：ユーザーが値をセルにペーストしたときには発生しません。

また、.Selectステートメントと.Activateステートメントをすべて削除して、オブジェクト自体で直接作業した方法にも注意してください。

Private Sub Worksheet_Change(ByVal Target As Range) 

With Me 

    If Not Intersect(Target, .Range("M5:M2500")) Is Nothing Then 

     Application.EnableEvents = False 
     .Unprotect Password:="unlock" 

     Dim rng As Range, cel As Range 
     Set rng = Target 

     For Each cel In rng 

      If InStr(1, cel, "Completed") Then 

       'use offset of 12 columns to get to column "Y" 

       cel.Offset(, 12).Value = Now 

      Else 

       cel.Offset(, 12).ClearContents 

      End If 

     Next 

     Application.EnableEvents = True 

    End If 

    '.Protect Password:="unlock" 

End With 

End Sub