跟踪工作表的变化，复制活动单元格行中非活动单元格的单元格并记录值

Question

我能够根据自己的需要调整以下公式，并且效果很好。我确实看到我需要添加一行来帮助锁定稍后发生的计算。如何编写以复制更改活动行的单元格“R”列中的值并继续将逻辑放置在 LogDetails 工作表的第 18 列中？

工作表中的代码：

Option Explicit
Public OldValue As String
         
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sSheetName As String
    
    sSheetName = "Capital"
    
    Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).value = ActiveSheet.Name
    Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 1).value = Environ("username")
    Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 2).value = Target.Address(0, 0)
    Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 10).value = Now
    Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 14).value = OldValue
    Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 15).value = Target.value
                 
    Application.EnableEvents = False
    Application.EnableEvents = True
    
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Selection.Cells.Count > 1 Then
        MsgBox "Multiple cell selections are not allowed on this sheet", vbCritical
        ActiveCell.Select
   Exit Sub
End If
   
    On Error Resume Next
    OldValue = Target.value
 
End Sub

欣赏和见解…！

Answer 1

首先我们不要重复自己。使用 With 关键字来处理对象。然后我们将在我们的选择更改中添加一个动态偏移量，以记录所选行的 R 列的值。我们将在您的 LogDetail 中使用它来将值放在第 18 列中。

Option Explicit
Public oldValue As Variant
Public currentRvalue As Variant
         
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sSheetName As String
    
    sSheetName = "Capital"
    
    With Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp)
        .Offset(1, 0).Value = ActiveSheet.Name
        .Offset(0, 1).Value = Environ("username")
        .Offset(0, 2).Value = Target.Address(0, 0)
        .Offset(0, 10).Value = Now
        .Offset(0, 14).Value = oldValue
        .Offset(0, 15).Value = Target.Value
        .Offset(0, 18).Value = currentRvalue
    End With
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Selection.Cells.Count > 1 Then
            MsgBox "Multiple cell selections are not allowed on this sheet", vbCritical
            ActiveCell.Select
       Exit Sub
    End If
   
    oldValue = Target.Value
    currentRvalue = Target.Offset(0, 18 - Target.Column).Value
End Sub

Answer 2

下面的代码结合了我通过您问题下的评论向您提出的建议。

我也稍微简化了代码...

Option Explicit
Public OldValue, OldColumnRValue

     
Private Sub Worksheet_Change(ByVal Target As Range)        
    Application.EnableEvents = False        
        With Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp)
            .Offset(1) = ActiveSheet.Name
            .Offset(, 1) = Environ("username")
            .Offset(, 2) = Target.Address(0, 0)
            .Offset(, 10) = Now
            .Offset(, 14) = OldValue
            .Offset(, 15) = Target
            .Offset(, 18) = OldColumnRValue
        End With                     
    Application.EnableEvents = True        
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)    
    If Selection.Cells.Count = 1 Then
        OldValue = Target
        OldColumnRValue = Range("A1")(Target.Row, 18)
        Exit Sub
    End If    
    MsgBox "Multiple cell selections are not allowed on this sheet", vbCritical
    ActiveCell.Select    
End Sub

跟踪工作表的变化，复制活动单元格行中非活动单元格的单元格并记录值

Track changes on worksheet, copy cell that is not the active cell in active cell row and record value

excel

vba

worksheet-function