Kelimeleri otomatik düzeltme

[hakki83]

Merhaba arkadaşlar

KISALTMALAR sayfasında isimlere verdiğim kısaltma kodları var.

VERİLER sayfasında B2:K500 aralığında hücreye kısaca kodu girip otomatik düzeltmesini istiyorum.

Örnek
53 yazınca FATİH CAN olarak düzeltsin
A yazınca ALİ VELİ olarak düzeltsin
gibi..

 

[Muzaffer Ali]

Merhaba. Veriler sayfasının kod kısmına aşağıdaki kodları kopyalayın.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Bul As Range
    If Not Intersect(Target, Range("B2:K500")) Is Nothing Then
        Set Bul = Worksheets("KISALTMALAR").Range("B:B").Find(what:=Target.Text, lookat:=xlWhole)
        If Bul Is Nothing Then
            MsgBox "Kıaltma bulunamadı."
        Else
            Application.EnableEvents = False
            Target = Bul(1, 0)
            Application.EnableEvents = True
        End If
    End If
End Sub

 

[hakki83]

Emeğinize sağlık. Çok teşekkür ederim.