Soru Makro İle Veri Doğrulama

[ormann]

İyi günler ;
Ekli örnek dosyada J3 hücresinden ŞEFLİĞİ ni seçtiğimizde J4,J5 ve J6 hücresine KAYIT sayfasındaki ilgili verileri makro ile nasıl alabiliriz ?

İndir ÖRNEK

Dosyayı indir ÖRNEK

dosya.co

 

[ormann]

Merhabalar,
Arkadaşlar konuya yardımcı olabilir misiniz

 

[numan şamil]

Merhaba
Bir Modüle aşağıdaki kodları yapıştırın

Sub Numan()
Dim SR1, SR2 As Worksheet
Dim x, satır As Long
Set SR1 = Sheets("VERİ")
Set SR2 = Sheets("kayıt")
SR1.Range("J4:J6").ClearContents
Application.ScreenUpdating = False
For x = 20 To SR2.Cells(Rows.Count, "J").End(3).Row
If SR1.Range("J3").Value <> "" And SR1.Range("J3").Value = SR2.Range("J" & x).Value Then
SR1.Range("J4").Value = SR2.Range("K" & x).Value
SR1.Range("J5").Value = SR2.Range("L" & x).Value
SR1.Range("J6").Value = SR2.Range("M" & x).Value
End If
Next x
Application.ScreenUpdating = True
End Sub

Veri sayfasının kod bölümüne

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo son
   If Intersect(Target, Range("J3")) Is Nothing Then Exit Sub
Numan
son:
End Sub

Yapıştırıp denermisiniz

 

[ormann]

Çok teşekkür ederim

 

[numan şamil]

İyi akşamlar

 

[ormann]

Sayın Numan asıl kodu kendi dosyama uyarladım.Fakat birleştirilmiş hücrede çalışmadı
Birleştirilmiş hücreler
J3:M3
J4:M4
J5:M5
J6:M6

 

[numan şamil]

Örnek dosya ekleyebilirmisiniz

 

[Hepgel]

Merhaba @ormann

Anladığım kadarıyla bu şekilde deneyebilir misiniz.

VERİ sayfası J3 seçiliyken veri doğrulama liste seçeneğine

=DOLAYLI("kayıt!J20:J"&KAÇINCI("ZZZ";kayıt!$J:$J;1))

Formülle sonuç almak için J4 hücresine

=EĞER($J$3="";"";DÜŞEYARA($J$3;kayıt!$J$20:$M$21;SATIR(A2);0))

formülünü uygulayıp aşağı doğru kopyala

Makro ile sonuç almak için VERİ sayfasının kod bölümüne şu kodu yapıştır.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [J3]) Is Nothing Then Exit Sub
Set s = Sheets("kayıt").Range("J20:J" & Rows.Count).Find(Target, , LookIn:=xlValues, LookAt:=xlWhole)
[J4:J6].ClearContents
If Not s Is Nothing Then
For su = 1 To 3: Target.Offset(su, 0) = Sheets("kayıt").Cells(s.Row, "J").Offset(0, su): Next
End If
End Sub

Son olarak J3 hücresinde açılan listeden şeflik seç