Excel的VBA - 細胞的變化，郵戳在一列

Question

我要創建兩個日期戳，一個用於確定和一個也不行。這些值填寫在A列中，分別爲'x' for OK和'NOK' for NOT OK。

當的「x」在列A中填充，在列49中的值應爲郵戳時的「x」填充。

當「NOK」在列在列填充，該值52應該是郵戳時「NOK」被填充。

此外，如果「X」或「NOK」從塔A除去，所以應該郵戳dissappear。這是我的。

Private Sub Worksheet_Change(ByVal Target As Range) 
    '49 = ok 
    '52 = NOK 

    Dim KeyCells As Range 

    ' The variable KeyCells contains the cells that will 
    ' cause an alert when they are changed. 
    Set LastRow = Range("A" & Rows.Count).End(xlUp).Row 
    Set KeyCells = Range("A1:" & LastRow) 

    If Application.Intersect(KeyCells, Range(Target.Address)) Like "*x*" Then 
     Cells(Row, 49).Value = Format(DateTime.Now, "yyyy-MM-dd hh:mm:ss") 
    End If 

    If Application.Intersect(KeyCells, Range(Target.Address)) Like "*NOK*" Then 
     Cells(Row, 52).Value = Format(DateTime.Now, "yyyy-MM-dd hh:mm:ss") 
    End If 

End Sub 

Answer 1

這裏，試試這個：

Private Sub Worksheet_Change(ByVal Target As Range) 
    '49 = ok '52 = NOK 
    Application.EnableEvents = False 

    With Target 
    'check if change happend in column A 
    If .Column = 1 Then 
     'check if changed value is X 
     If .Value Like "*x*" Then 
      'add datestamp if it is 
      Cells(.Row, 49).Value = Format(DateTime.Now, "yyyy-MM-dd hh:mm:ss") 
     Else 
      'clear datestamp if not 
      Cells(.Row, 49).Value = "" 
     End If 

     If .Value Like "*NOK*" Then 
      Cells(.Row, 52).Value = Format(DateTime.Now, "yyyy-MM-dd hh:mm:ss") 
     Else 
      Cells(.Row, 52).Value = "" 
     End If 
    End If 
    End With 
    Application.EnableEvents = True 
End Sub