Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ru As Range
    On Error Resume Next
    Set ru = Intersect(Target, ActiveSheet.UsedRange)
    On Error GoTo 0
    If ru Is Nothing Then Exit Sub
    
    Dim vl As Validation
    Dim ra As Range
    Dim rv As Range
    Dim cl As Range
    Dim ya As Long
    For Each cl In ru.Cells
        On Error Resume Next
        Set vl = cl.Validation
            If Not vl Is Nothing Then
                Set rv = Range(Mid(vl.Formula1, 2))
                If Not rv Is Nothing Then
                    ya = WorksheetFunction.Match(cl.Value, rv, 0)
                    If ya > 0 Then
                        Set ra = rv.Cells(ya, 1)
                        Application.EnableEvents = False
                        cl.FormulaR1C1 = "=" & ra.Address(1, 1, xlR1C1)
                        Application.EnableEvents = True
                    End If
                End If
            End If
        On Error GoTo 0
    Next
End Sub