Option Explicit
Dim d As New Dictionary

Private Sub Worksheet_Change(ByVal Target As Range)
'Нужно включить библиотеку "Microsoft scripting runtime"
Dim m, i&, n&, s$
If Target.Column <> 4 Or Target.CountLarge > 1 Then Exit Sub

Application.EnableEvents = False
Target.Value = rep(Target.Value)
Application.EnableEvents = True

If d.Count = 0 Then 'это раскоментировать, чтобы каждый раз не происходило заполнение словаря не будет притормаживать, но если будут изменения в 2-м листе нужно будет закрыть и открыть книгу для заполнения словаря.

d.RemoveAll
         With Sheets("Тех замены")
             n = .Cells(Rows.Count, 2).End(xlUp).Row
             m = .Range("a1:b" & n).Value
             For i = 1 To UBound(m)
             If Not d.exists(m(i, 1)) Then d.Add m(i, 1), m(i, 2)
             Next
         End With
End If 'это раскоментировать, чтобы каждый раз не происходило заполнение словаря не будет притормаживать, но если будут изменения в 2-м листе нужно будет закрыть и открыть книгу для заполнения словаря.
If d.exists(Target.Value) Then MsgBox "Нужно добавить код: " & d.Item(Target.Value)
End Sub

Private Function rep(s$) As String
Dim mEn, mRu, i&
mEn = Array("q", "w", "e", "r", "t", "y", "u", "i", "o", "p", "[", "]", "a", "s", "d", "f", "g", "h", "j", "k", "l", ";", "", "\", "z", "x", "c", "v", "b", "n", "m", ",", ".")
mRu = Array("й", "ц", "у", "к", "е", "н", "г", "ш", "щ", "з", "х", "ъ", "ф", "ы", "в", "а", "п", "р", "о", "л", "д", "ж", "э", "\", "я", "ч", "с", "м", "и", "т", "ь", "б", "ю")
For i = 0 To UBound(mEn): s = Replace(s, mRu(i), mEn(i), , , vbTextCompare): Next
rep = UCase(s)
End Function