hücrelere kısayol atama

[mayagul]

Merhaba , 35 personele ait liste oluştururken hücreye 1 yazdığımda örneğin ali kaya gibi tanımlama yapılabilir mi?
Teşekkürler..
EKTE OLUŞTURDUĞUM TABLO MEVCUT.

 

[Ömer]

Merhaba,

data isminde bir sayfa oluşturun, bu sayfanın A sütununa tanımlama numaralarını yazın, B sütununa da tanımlamalara ait isimleri yazın.

Daha sonra aşağıdaki kodları "MANİSA KBM - ORG TABLOSU" sayfası kod bölümüne yapıştırın. J sütununa tanımladığınız numaraları girdiğinizde isim karşılıkları hücreye yazılacaktır.

Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim Sd As Worksheet, c As Range
 
    If Intersect(Target, [J:J]) Is Nothing Then Exit Sub
 
    Set Sd = Sheets("data")
 
    With Target
        If .Count > 1 Then Exit Sub
        If .Row < 4 Then Exit Sub
        If .Value = "" Then Exit Sub
        Set c = Sd.[A:A].Find(.Value, , xlValues, xlWhole)
        If Not c Is Nothing Then
            Application.EnableEvents = False
                .Value = Sd.Cells(c.Row, "B")
            Application.EnableEvents = True
        Else
            MsgBox "Tanımı Bulamadım"
        End If
    End With
 
End Sub

.

 

[mayagul]

Çok teşekkür ederim , tanımalmayı B-C-D-E-F-G-( J DE VAR ) K-L-M-N-P-O-R ,hücrelerinde olacak şekilde genişletebilir miyiz?

 

[Ömer]

Bu şekilde deneyin.

Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim Sd As Worksheet, c As Range
 
    If Intersect(Target, [B:R]) Is Nothing Then Exit Sub
 
    Set Sd = Sheets("data")
 
    With Target
        If .Column = 8 And .Column = 9 Then Exit Sub
        If .Count > 1 Then Exit Sub
        If .Row < 4 Then Exit Sub
        If .Value = "" Then Exit Sub
        Set c = Sd.[A:A].Find(.Value, , xlValues, xlWhole)
        If Not c Is Nothing Then
            Application.EnableEvents = False
                .Value = Sd.Cells(c.Row, "B")
            Application.EnableEvents = True
        Else
            MsgBox "Tanımı Bulamadım"
        End If
    End With
 
End Sub

.

 

[mayagul]

Çok teşekkür ederim, elinize sağlık..