Makro İle Veri doğrulama

[ormann]

İyi günler;
ekteki örnek dosyada g13 hücresinden kişinin adını seçtiğimizde g17 hücresine kişinin soyadı yazacak.Bu işlemin tersi olarak g17 hücresinden kişinin soyadınız seçtiğimizde ise g13 hücresine kişinin adını yazacak.Yardımcı olabilirmisiniz.? Saygılar

 

[hamitcan]

Aşağıdaki kodu veri sayfasının kod kısmına ekleyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
        If Not Intersect(Target, [g13]) Is Nothing Then
            For Each hcr In Sheets("kayıt").[d7:d16]
               If Target.Text = hcr.Text Then [g17] = Sheets("kayıt").Cells(hcr.Row, 5)
            Next
        End If
    Application.EnableEvents = True
    Application.EnableEvents = False
        If Not Intersect(Target, [g17]) Is Nothing Then
            For Each hcr2 In Sheets("kayıt").[e7:e16]
               If Target.Text = hcr2.Text Then [g13] = Sheets("kayıt").Cells(hcr2.Row, 4)
            Next
        End If
    Application.EnableEvents = True
End Sub

 

[ormann]

Sayın Hamit bey çok teşekkür ederim.Yapmış olduğunuz kod örnek dosyada çalıştı fakat bir türlü asıl dosyada çalıştıramadım hata veriyor.
Asıl dosyada g13 hücresinden bölmeyi seçtiğim zaman ebat listesi sayfasındaki istif yerini g17 hücresine yazacak.g17 hücresinden ise istif yerini seçtiğimde ebat listesi sayfasındaki bölme numarasını g13 hücresine yazacak .Kodu sizden rica etsem bu dosyaya uyarlayabilirmisiniz.

 

[hamitcan]

Kod içinde biraz düzenlemeler yaptım, aynen eski kodlarınızın üzerine yapıştırınız.
Bir de bazı sayfalarınız mevcut değil bu da Open ve Close başlıklı kodlarınızın çalışmasını dolayısıyla verdiğim kodun çalışmasını engelleyebilir ya bu kodları tamamen devre dışı bırakın yada olmayan sayfaları ekleyin.

'Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
        If Not Intersect(Target, [g13]) Is Nothing Then
            For Each hcr2 In Sheets("ebat listeleri").Range("g7:g" & [g65536].End(3).Row)
               If Target.Text = hcr2.Text Then [g17] = Sheets("ebat listeleri").Cells(hcr2.Row, 5)
            Next
        End If
    Application.EnableEvents = True
    Application.EnableEvents = False
        If Not Intersect(Target, [g17]) Is Nothing Then
            For Each hcr10 In Sheets("ebat listeleri").Range("e7:e" & [e65536].End(3).Row)
               If Target.Text = hcr10.Text Then [g13] = Sheets("ebat listeleri").Cells(hcr10.Row, 7)
        
        
            Next
        End If
    Application.EnableEvents = True
End Sub

 

[ormann]

Hamit bey ne yazıkki dosyayı çalıştıramadım.Devamlı olarak hata veriyor.Dosyanın orjinal halini gönderiyorum.Şifre:1978

 

[hamitcan]

Değişken tanımlarını yapmadığımız için kızıyordu, düzelttim.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim hcr2 As Variant
Dim hcr10 As Variant

    Application.EnableEvents = False
        If Not Intersect(Target, [g13]) Is Nothing Then
            For Each hcr2 In Sheets("ebat listeleri").Range("g7:g" & [g65536].End(3).Row)
               If Target.Text = hcr2.Text Then [g17] = Sheets("ebat listeleri").Cells(hcr2.Row, 5)
            Next
        End If
    Application.EnableEvents = True
    Application.EnableEvents = False
        If Not Intersect(Target, [g17]) Is Nothing Then
            For Each hcr10 In Sheets("ebat listeleri").Range("e7:e" & [e65536].End(3).Row)
               If Target.Text = hcr10.Text Then [g13] = Sheets("ebat listeleri").Cells(hcr10.Row, 7)
        
        
            Next
        End If
    Application.EnableEvents = True
End Sub

 

[ormann]

Hamit bey iyi günler
g13 ten seçim yazdığım zaman g17 hücresine veriyi getiriyor.Fakat G17 gücresinden seçtiğim veriyi g13 hücresine getirmiyor

 

[hamitcan]

Hata benden kaynaklanmış, düzelttim, bir de böyle deneyin.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim hcr2 As Variant
Dim hcr10 As Variant

    Application.EnableEvents = False
        If Not Intersect(Target, [g13]) Is Nothing Then
            For Each hcr2 In Sheets("ebat listeleri").Range("g7:g" & Sheets("ebat listeleri").[g65536].End(3).Row)
               If Target.Text = hcr2.Text Then [g17] = Sheets("ebat listeleri").Cells(hcr2.Row, 5)
            Next
        End If
        If Not Intersect(Target, [g17]) Is Nothing Then
            For Each hcr10 In Sheets("ebat listeleri").Range("e7:e" & Sheets("ebat listeleri").[e65536].End(3).Row)
               If Target.Text = hcr10.Text Then [g13] = Sheets("ebat listeleri").Cells(hcr10.Row, 7)
            Next
        End If
    Application.EnableEvents = True
End Sub

 

[ormann]

Çok teşekkür ederim Hamit bey .Ellerinize sağlık