验证列表值变更追加单元格+状态变更时Hours列加负号的事件失效问题

Hey there! Let's work through your two Excel automation needs, and fix the issue you hit with the Worksheet_Change event for your second requirement.

To make this work, we'll use the Worksheet_Change event to detect when a cell in your validation list is updated, then append the new value to its paired cell. Here's a flexible implementation (adjust ranges to match your sheet):

Private Sub Worksheet_Change(ByVal Target As Range)
    ' Define your validation list range (update this to your actual cells)
    Dim validationRange As Range
    Set validationRange = Me.Range("A1:A10")
    
    ' Exit if the changed cell isn't in the validation list
    If Intersect(Target, validationRange) Is Nothing Then Exit Sub
    
    Application.EnableEvents = False
    With Target
        ' Append the new value to the corresponding cell (example: 1 column to the right)
        ' Add a comma separator if there's existing content to keep things clean
        If .Offset(, 1).Value <> "" Then
            .Offset(, 1).Value = .Offset(, 1).Value & ", " & .Value
        Else
            .Offset(, 1).Value = .Value
        End If
    End With
    Application.EnableEvents = True
End Sub

Note: Update validationRange to match where your dropdown list lives, and adjust the Offset(,1) to point to the cell you want to append content to.

Your original code had a couple of issues: it didn't check if the status actually changed from Pending to Completed, and it was clearing the status cell (which you probably don't want). Let's fix that with a version that properly detects the status transition:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim statusRange As Range
    Dim hoursColOffset As Integer
    Dim oldStatus As String
    Dim newStatus As String
    
    ' Define your status column range (matches your original C5:C14)
    Set statusRange = Me.Range("C5:C14")
    ' Hours column is 1 column left of status (column B, adjust if needed)
    hoursColOffset = -1
    
    ' Only process single-cell changes to avoid unexpected behavior
    If Intersect(Target, statusRange) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
    
    Application.EnableEvents = False
    
    ' Trick to get the old status value before the change
    Application.Undo
    oldStatus = Target.Value
    Application.Undo ' Restore the new status value
    
    newStatus = Target.Value
    
    ' Check for the specific status transition (case-insensitive)
    If LCase(oldStatus) = "pending" And LCase(newStatus) = "completed" Then
        Dim hoursCell As Range
        Set hoursCell = Target.Offset(, hoursColOffset)
        
        ' Handle numeric hours (convert to negative) or text (prepend "-")
        If IsNumeric(hoursCell.Value) Then
            hoursCell.Value = -Abs(hoursCell.Value) ' Ensure it's negative no matter the original sign
        Else
            hoursCell.Value = "-" & hoursCell.Value
        End If
    End If
    
    Application.EnableEvents = True
End Sub

Key fixes from your original code: #

• We explicitly check if the status changed from Pending to Completed (using LCase to avoid case sensitivity issues)
• We don't clear the status cell anymore (removed the .ClearContents line)
• We handle both numeric and text values in the Hours column
• We use a safe way to retrieve the old status value without losing the new one

If you need both automations to run in the same worksheet, merge the logic into one Worksheet_Change event (make sure the ranges don't overlap, or adjust the flow if they do):

Private Sub Worksheet_Change(ByVal Target As Range)
    ' --- Requirement 1: Append validation list changes ---
    Dim validationRange As Range
    Set validationRange = Me.Range("A1:A10") ' Adjust to your validation list
    
    If Not Intersect(Target, validationRange) Is Nothing Then
        Application.EnableEvents = False
        With Target
            If .Offset(, 1).Value <> "" Then
                .Offset(, 1).Value = .Offset(, 1).Value & ", " & .Value
            Else
                .Offset(, 1).Value = .Value
            End If
        End With
        Application.EnableEvents = True
        Exit Sub ' Remove this line if your validation range overlaps with the status range
    End If
    
    ' --- Requirement 2: Update Hours on status transition ---
    Dim statusRange As Range
    Dim hoursColOffset As Integer
    Dim oldStatus As String
    Dim newStatus As String
    
    Set statusRange = Me.Range("C5:C14")
    hoursColOffset = -1
    
    If Intersect(Target, statusRange) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
    
    Application.EnableEvents = False
    
    Application.Undo
    oldStatus = Target.Value
    Application.Undo
    
    newStatus = Target.Value
    
    If LCase(oldStatus) = "pending" And LCase(newStatus) = "completed" Then
        Dim hoursCell As Range
        Set hoursCell = Target.Offset(, hoursColOffset)
        
        If IsNumeric(hoursCell.Value) Then
            hoursCell.Value = -Abs(hoursCell.Value)
        Else
            hoursCell.Value = "-" & hoursCell.Value
        End If
    End If
    
    Application.EnableEvents = True
End Sub

内容的提问来源于stack exchange，提问作者beepbop