Worksheet_SelectionChange - Farklı sütunlarda zaman damgası

Question

Bir görevi değiştirirken Completed'a çalışanların öncelik listesini damgalamak için aşağıdaki kodu kullanıyorum. Kod düzgün çalışıyor ancak değişiklikleri izlemek istediğim her hücre için çoğaltılması gerekiyor.

İdeal olarak, kodun tam olarak aynı işleve sahip olmasını istiyorum, böylece büyük bir görünüme sahip olabilirim. aralığı, M5:M2500 ve M250 hücresi Completed olarak değiştirilmişse Y5:Y500'a bakıp Y250 hücresine zaman damgasını yapıştırın.

Bu tavsiyeyi ve önerilerinizi için teşekkürler.

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

Çok temiz sağ Worksheet_Change olayın kendi içinde yapabilirsiniz. Bu kod, değiştirilen M satırındaki satırı değerlendirecek ve buna karşılık gelen satırı Y olarak değiştirecek ve aynı zamanda bir kullanıcı aynı anda birden fazla satırın tamamlandığını işaret edecek (Ctrl + Enter). Uyarı, kullanıcı bir değeri hücreye yapıştırdığında yanmaz.

Ayrıca, tüm .Select ve .Activate ifadelerini kaldırdığıma ve doğrudan nesnelerin kendileriyle çalışmamıza dikkat edin.

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