Akıllı Tamamlama

[attrd]

İyi günler yardımınız için şimdiden teşekürler ,
A1, ile E35 hücreleri arasından herhangi birine klavyeden
A , yazınca = Ali
AY, yazınca = Ayhan
B , yazınca = Burhan
BA, yazınca = Barkın
C , yazınca = Cengiz
VbA veya makro Kod ile Tamamlamasını istiyorum ,diger hücrelerde tamamlamasına gerek yok ,
Yardımınız için Şimdiden cok tesekür ederim.

 

[bmutlu966]

Sayfanın kod bölümüne yapıştırıp deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
   
    If Intersect(Target, Range("A1:E35")) Is Nothing Then Exit Sub
    Cancel = True
   
    If Cells(Target.Row, Target.Column) = "A" Then Target = "Ali"
    If Cells(Target.Row, Target.Column) = "AY" Then Target = "Ayhan"
    If Cells(Target.Row, Target.Column) = "B" Then Target = "Burhan"
    If Cells(Target.Row, Target.Column) = "BA" Then Target = "Barkın"
    If Cells(Target.Row, Target.Column) = "C" Then Target = "Cengiz"

End Sub

 

[Necdet]

Alternatif olsun

Adı Sayfa2 olan bir sayfayanın A sütununa kısaltmayı B sütununa ise açıklamayı yazın. Bu durumda kodla uğraşmadan yeni kısaltmalar ekleyebilirsiniz.
Kodlar Büyük/Küçük Harf duyarlı değildir.
Kodları ilgili sayfanın kod bölümüne kopyalayıp deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [A1:E35]) Is Nothing Or Target.Value = "" Then Exit Sub
Dim c As Range

With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

Set c = Sheets("Sayfa2").Range("A:A").Find(UCase(Replace(Replace(Target.Value, "i", "İ"), "ı", "I")), LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then Target.Value = Sayfa2.Cells(c.Row, "B")

With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With

End Sub

 

[attrd]

Alternatif olsun

Adı Sayfa2 olan bir sayfayanın A sütununa kısaltmayı B sütununa ise açıklamayı yazın. Bu durumda kodla uğraşmadan yeni kısaltmalar ekleyebilirsiniz.
Kodlar Büyük/Küçük Harf duyarlı değildir.
Kodları ilgili sayfanın kod bölümüne kopyalayıp deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [A1:E35]) Is Nothing Or Target.Value = "" Then Exit Sub
Dim c As Range

With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

Set c = Sheets("Sayfa2").Range("A:A").Find(UCase(Replace(Replace(Target.Value, "i", "İ"), "ı", "I")), LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then Target.Value = Sayfa2.Cells(c.Row, "B")

With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With

End Sub

Tesekür ederim hocam deniyecegim

 

[attrd]

Sayfanın kod bölümüne yapıştırıp deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
  
    If Intersect(Target, Range("A1:E35")) Is Nothing Then Exit Sub
    Cancel = True
  
    If Cells(Target.Row, Target.Column) = "A" Then Target = "Ali"
    If Cells(Target.Row, Target.Column) = "AY" Then Target = "Ayhan"
    If Cells(Target.Row, Target.Column) = "B" Then Target = "Burhan"
    If Cells(Target.Row, Target.Column) = "BA" Then Target = "Barkın"
    If Cells(Target.Row, Target.Column) = "C" Then Target = "Cengiz"

End Sub

Teşekür ederim hocam deniyecegim