Mostra o timestamp quando a célula é alterada

1

Eu preciso saber como mostrar um registro de data e hora em uma célula na coluna D quando uma célula muda na mesma linha na coluna B. Editei essa captura de tela para mostrar o que quero dizer com mais facilidade: A imagem

Eu tenho um script vba que verifica uma folha diferente para um valor que ele insere na coluna B. Isso acontece com o evento select Worksheet_SelectionChange, então não posso simplesmente adicionar:

Range("D3").Value = Now()

Ou algo parecido com isso, pois ele será atualizado toda vez que eu selecionar algo e só preciso atualizá-lo quando a célula na coluna B for alterada. O valor na coluna B contém apenas os números 0, 1 ou 2 entre

    
por Crecket 06.03.2015 / 16:02

2 respostas

2

Este código VBA fará isso:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim wk As Workbook
Set wk = ThisWorkbook
Dim ws As Worksheet
Set ws = ActiveSheet
WatchedColumn = 2
BlockedRow = 1
TimestampColumn = 4
Crow = Target.Row
CColumn = Target.Column
If CColumn = WatchedColumn And Crow > BlockedRow Then
    Cells(Crow, TimestampColumn) = Now()
End If

End Sub

Você tem que copiar o código, vá em Exibir - > Macros no Excel, Crie um novo nome (qualquer nome é válido) e na coluna da esquerda dê um duplo clique na planilha onde você quer usá-lo (bandeira vermelha na foto) e no lado direito, cole o código.

Esta macro modifica o conteúdo da célula na coluna D sempre que houver uma mudança na mesma linha na coluna B. A variável BlockedRow protege a primeira linha porque geralmente tem rótulos, se você tiver mais de uma linha de rótulos mudou a variável para 2 ou mais.

Se você precisar alterar as colunas, faça a alteração nas variáveis WatchedColumn e TimestampColumn . (A = 1, B = 2, C = 3, D = 4, ... e assim por diante).

    
por 06.03.2015 / 16:13
1

Eu sei que já existe uma resposta, mas este VBA é um pouco mais limpo -

Private Sub worksheet_change(ByVal target As Range)
 If Not Intersect(target, Range("B:B")) Is Nothing Then
  target.Offset(0, 2) = Now()
 End If
End Sub

Para ajustar a sua outra exigência, não na pergunta, basta adicionar um if -

Private Sub worksheet_change(ByVal target As Range)
    If Not Intersect(target, Range("B:B")) Is Nothing Then
        If target.Row > 1 Then
           target.Offset(0, 2) = Now()
        End If
    End If
End Sub
    
por 06.03.2015 / 20:42