ATUALIZAÇÃO
O VBA está funcionando! Por favor veja o código abaixo. Só preciso de ajuda para modificá-lo para que, quando eu alterar uma célula na Coluna I, ela salve o valor na Coluna H.
Dim xRg como intervalo
Dim xChangeRg como intervalo
Dim xDependRg como intervalo
Dim xDic como novo dicionário
Private Sub Worksheet_Change (ByVal Target As Range)
Escurecer eu enquanto
Dim xCell como intervalo
Dim xDCell como intervalo
Dim xHeader como String
Dim xCommText como string
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
xHeader = "Valor anterior:"
x = xDic.Keys
Para I = 0 Para UBound(xDic.Keys)
Definir xCell = Range(xDic.Keys(I))
Definir xDCell = Cells(xCell.Row, 5)
xDCell.Value = ""
xDCell.Value = xDic.Items(I)
Próximo
Se Target.Column = 6 Then
Application.EnableEvents = False
Cells(Target.Row, 7).Value = Data
Application.EnableEvents = True
Se acabar
Se Target.Column = 9 Then
Application.EnableEvents = False
Cells(Target.Row, 10).Value = Data
Application.EnableEvents = True
Se acabar
Application.EnableEvents = True
End Sub
Sub Worksheet_SelectionChange particular (destino ByVal como intervalo)
Dim I, J Enquanto
Dim xRgArea como intervalo
Em caso de erro Ir para Label1
Se Target.Count > 1, então Exit Sub
Application.EnableEvents = False
Definir xDependRg = Target.Dependents
Se xDependRg não for nada, vá para Label1
Se não, xDependRg não é nada, então
Set xDependRg = Intersect(xDependRg, Range("F:F"))
Se acabar
Marca1:
Set xRg = Intersect(Target, Range("F:F"))
Se (não xRg é nada) e (não xDependRg não é nada) então
Defina xChangeRg = Union(xRg, xDependRg)
ElseIf (xRg é nada) e (não xDependRg é nada) Então
Defina xChangeRg = xDependRg
ElseIf (não xRg é nada) e (xDependRg não é nada) então
Definir xChangeRg = xRg
Outro
Application.EnableEvents = True
Exit Sub
Se acabar
xDic.RemoveAll
Para I = 1 To xChangeRg.Areas.Count
Defina xRgArea = xChangeRg.Areas(I)
Para J = 1 To xRgArea.Count
xDic.Adicionar xRgArea(J).Endereço, xRgArea(J).Fórmula
Próximo
Próximo
Definir xChangeRg = Nada
Definir xRg = Nada
Definir xDependRg = Nada
Application.EnableEvents = True
End Sub