Excel单元格值的更改会在另一个单元格中插入“S”

Question

我粘贴了工作表1。注意列。要监视的那个是标题描述和Healthman。一旦在列下发生更改，就会插入一个S。例如，Spectacle Frame更改为Spec Frame，我们在Change下插入S.更改列是空的。在Healthman下面，当价格变化时，在变更栏中插入一个P.当要删除产品时，即删除行时，将在更改下插入X.当插入一行时，因为我正在与一个隐藏表格单元格进行比较，这就是隐藏表格被更新的原因。我尝试了以前的代码，它不工作，并认为粘贴表单进行审查。
图例：P =价格涨跌
N = NEW X = DELETED S =说明
代码变更说明HEALTHMAN

40501  Spectacle Frame    
    40609  Sunglasses    
    40525 S Ready Made Optical    
    41008  Spectacle Case    
    43025 P Transfer - Zyl or Metal Frame 198.00   
    43126 P Transfer - Nylon Supra Frame 314.00   
    43136 P Transfer - Rimless Frame 359.00  

Answer 1

可以使用Worksheet_Change事件。例如参见this和that。 -

示例代码添加到Workseet A3将自动当你改变另一个细胞如果改变细胞是A1改变，与特定行为：

Private Sub Worksheet_Change(ByVal Target As Range) 
    If Target.Address = Range("A1").Address Then 
     Range("A3") = "You changed A1" 
    ElseIf Target.Address <> Range("A3").Address Then 'to prevent a change of A3 to trigger an update 
     Range("A3") = "You changed another cell" 
    End If 
End Sub 

Answer 2

虽然与Worksheet_Change工作，你必须确保两件事。

1）相应的错误处理是必须的

2）关闭.EnableEvents以避免无限循环的可能性。

的假设

1）要捕获更改单元格A1

2）你想在A2显示 “S”

所以，请更改为适用于下面的代码。

CODE

Private Sub Worksheet_Change(ByVal Target As Range) 
    On Error GoTo Whoa 

    If Not Intersect(Target, Range("A1")) Is Nothing Then 
     Application.EnableEvents = False 
     Range("A2").Value = "S" 
    End If 

LetsContinue: 
    Application.EnableEvents = True 
    Exit Sub 
Whoa: 
    MsgBox Err.Description 
    Resume LetsContinue 
End Sub 

随访

这是你想什么呢？

这发生在“ThisWorkbook”代码区域。

Private Sub Workbook_Open() 
    Dim hiddenSheet As Worksheet 

    Set hiddenSheet = Me.Worksheets.Add 
    hiddenSheet.Visible = xlSheetVeryHidden 

    On Error Resume Next 
    Application.DisplayAlerts = False 
    Sheets("HiddenSheet").Delete 
    Application.DisplayAlerts = True 
    On Error GoTo 0 

    hiddenSheet.Name = "HiddenSheet" 

    Sheet1.Range("A1:D15").Copy hiddenSheet.Range("A1:D15") 
End Sub 

Private Sub Workbook_BeforeClose(Cancel As Boolean) 
    On Error Resume Next 
    Application.DisplayAlerts = False 
    Sheets("HiddenSheet").Delete 
    Application.DisplayAlerts = True 
    On Error GoTo 0 
End Sub 

和这正好在相关工作表区域

Private Sub Worksheet_Change(ByVal Target As Range) 
    On Error GoTo Whoa 

    If Not Intersect(Target, Range("A1:D15")) Is Nothing Then 
     Dim old_value 

     Application.EnableEvents = False 

     old_value = Sheets("HiddenSheet").Range(Target.Address).Value 

     If Target.Value <> old_value Then 
      '~~> Change 1 to whatever offset that you want. 
      Target.Offset(0, 1).Value = "S" 
     End If 
    End If 

LetsContinue: 
    Application.EnableEvents = True 
    Exit Sub 
Whoa: 
    MsgBox Err.Description 
    Resume LetsContinue 
End Sub 

HTH

希德