Como lembrar ou salvar o valor da célula anterior de uma célula alterada no Excel?
Normalmente, ao atualizar uma célula com novo conteúdo, o valor anterior será coberto, a menos que desfaça a operação no Excel. No entanto, se você quiser manter o valor anterior para comparação com o atualizado, salvar o valor da célula anterior em outra célula ou no comentário da célula será uma boa escolha. O método neste artigo irá ajudá-lo a alcançá-lo.
Salve o valor da célula anterior com o código VBA no Excel
Salve o valor da célula anterior com o código VBA no Excel
Supondo que você tenha uma tabela como a imagem mostrada abaixo. Se qualquer célula na coluna C mudou, você deseja salvar seu valor anterior na célula correspondente da coluna G ou salvar no comentário automaticamente. Faça o seguinte para alcançá-lo.
1. Na planilha contém o valor que você salvará ao atualizar, clique com o botão direito na guia da planilha e selecione Ver código no menu do botão direito. Veja a imagem:
2. Na abertura Microsoft Visual Basic para Aplicações janela, copie o código VBA abaixo para a janela de código.
O código VBA a seguir ajuda a salvar o valor da célula anterior da coluna especificada em outra coluna.
Código VBA: salve o valor da célula anterior em outra célula da coluna
Dim xRg As Range
Dim xChangeRg As Range
Dim xDependRg As Range
Dim xDic As New Dictionary
Private Sub Worksheet_Change(ByVal Target As Range)
Dim I As Long
Dim xCell As Range
Dim xDCell As Range
Dim xHeader As String
Dim xCommText As String
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
xHeader = "Previous value :"
x = xDic.Keys
For I = 0 To UBound(xDic.Keys)
Set xCell = Range(xDic.Keys(I))
Set xDCell = Cells(xCell.Row, 7)
xDCell.Value = ""
xDCell.Value = xDic.Items(I)
Next
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim I, J As Long
Dim xRgArea As Range
On Error GoTo Label1
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
Set xDependRg = Target.Dependents
If xDependRg Is Nothing Then GoTo Label1
If Not xDependRg Is Nothing Then
Set xDependRg = Intersect(xDependRg, Range("C:C"))
End If
Label1:
Set xRg = Intersect(Target, Range("C:C"))
If (Not xRg Is Nothing) And (Not xDependRg Is Nothing) Then
Set xChangeRg = Union(xRg, xDependRg)
ElseIf (xRg Is Nothing) And (Not xDependRg Is Nothing) Then
Set xChangeRg = xDependRg
ElseIf (Not xRg Is Nothing) And (xDependRg Is Nothing) Then
Set xChangeRg = xRg
Else
Application.EnableEvents = True
Exit Sub
End If
xDic.RemoveAll
For I = 1 To xChangeRg.Areas.Count
Set xRgArea = xChangeRg.Areas(I)
For J = 1 To xRgArea.Count
xDic.Add xRgArea(J).Address, xRgArea(J).Formula
Next
Next
Set xChangeRg = Nothing
Set xRg = Nothing
Set xDependRg = Nothing
Application.EnableEvents = True
End SubPara salvar o valor da célula anterior em um comentário, aplique o código VBA abaixo
Código VBA: Salve o valor da célula anterior no comentário
Dim xRg As Range
Dim xChangeRg As Range
Dim xDependRg As Range
Dim xDic As New Dictionary
Private Sub Worksheet_Change(ByVal Target As Range)
Dim I As Long
Dim xCell As Range
Dim xHeader As String
Dim xCommText As String
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
xHeader = "Previous value :"
For I = 0 To UBound(xDic.Keys)
Set xCell = Range(xDic.Keys(I))
If Not xCell.Comment Is Nothing Then xCell.Comment.Delete
With xCell
.AddComment
.Comment.Visible = False
.Comment.Text xHeader & vbCrLf & xDic.Items(I)
End With
Next
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim I, J As Long
Dim xRgArea As Range
On Error GoTo Label1
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
Set xDependRg = Target.Dependents
If xDependRg Is Nothing Then GoTo Label1
If Not xDependRg Is Nothing Then
Set xDependRg = Intersect(xDependRg, Range("C:C"))
End If
Label1:
Set xRg = Intersect(Target, Range("C:C"))
If (Not xRg Is Nothing) And (Not xDependRg Is Nothing) Then
Set xChangeRg = Union(xRg, xDependRg)
ElseIf (xRg Is Nothing) And (Not xDependRg Is Nothing) Then
Set xChangeRg = xDependRg
ElseIf (Not xRg Is Nothing) And (xDependRg Is Nothing) Then
Set xChangeRg = xRg
Else
Application.EnableEvents = True
Exit Sub
End If
xDic.RemoveAll
For I = 1 To xChangeRg.Areas.Count
Set xRgArea = xChangeRg.Areas(I)
For J = 1 To xRgArea.Count
xDic.Add xRgArea(J).Address, xRgArea(J).Text
Next
Next
Set xChangeRg = Nothing
Set xRg = Nothing
Set xDependRg = Nothing
Application.EnableEvents = True
End SubNote: No código, o número 7 indica a coluna G na qual você salvará a célula anterior e C: C é a coluna na qual você salvará o valor da célula anterior. Altere-os de acordo com suas necessidades.
3. Clique Ferramentas > Referências para abrir o Refereces - VBAProject caixa de diálogo, verifique a Tempo de execução de scripts da Microsoft e, finalmente, clique no OK botão. Veja a imagem:
4. aperte o outro + Q chaves para fechar o Microsoft Visual Basic para Aplicações janela.
A partir de agora, quando o valor da célula na coluna C for atualizado, o valor anterior da célula será salvo nas células correspondentes na coluna G, ou será salvo no comentário como mostrado nas capturas de tela abaixo.
Salve os valores das células anteriores em outras células:
Salve os valores das células anteriores nos comentários:
Melhores ferramentas de produtividade de escritório
Aprimore suas habilidades de Excel com o Kutools para Excel e experimente uma eficiência como nunca antes. Kutools para Excel oferece mais de 300 recursos avançados para aumentar a produtividade e economizar tempo. Clique aqui para obter o recurso que você mais precisa...
Office Tab traz interface com guias para o Office e torna seu trabalho muito mais fácil
- Habilite a edição e leitura com guias em Word, Excel, PowerPoint, Publisher, Access, Visio e Project.
- Abra e crie vários documentos em novas guias da mesma janela, em vez de em novas janelas.
- Aumenta sua produtividade em 50% e reduz centenas de cliques do mouse para você todos os dias!
