Hücreye tıklama ile tabloya veri aktarımı ?

[mybluecat]

Ek teki dosyada 1 nolu tablodaki ASYA veya AVRUPA BÖLGESİ yazılarına tıklandığında alttaki alttaki tabloya ilgili listelerden veriler geliyor.Aynı şekilde 2 nolu tabloya gelen verilerden A yazan hücreye tıkladığım da A nın altında bulunan AA,BB ... yazan listenin, F yazan hücreye tıkladığımda F nin altında bulunan FF,HH... yazan listenin gelmesini istiyorum.Aynı işlemler B,C,D,E vb yazan hücreler içinde geçerli olacak ve 4. bir tablo da ilave edilebilir.Bu şekilde kademe kademe veriler aktarılabilir mi? Birinci tablo için yazılan kod buna yönelik geliştirilebilir mi?

Teşekkürler....

 

[muygun]

Merhaba;
Tablo yapısını biraz değiştirerek ekteki gibi olabilir.
İnceleyin.
İyi çalışmalar.

 

[mybluecat]

Elinize sağlık.Bu kodun ;

If satt >= 14 And satt <= 18 Then
aranan = s1.Cells(satt, "e")
sat1 = 23
For k = 5 To 100
If s1.Cells(k, "m") = aranan Then
s1.Cells(sat1, "e") = s1.Cells(k, "n")
s1.Cells(sat1 + 1, "e") = s1.Cells(k, "o")
s1.Cells(sat1 + 2, "e") = s1.Cells(k, "p")
s1.Cells(sat1 + 3, "e") = s1.Cells(k, "q")
s1.Cells(sat1 + 4, "e") = s1.Cells(k, "r")
End If
Next k
End If

kısmından birkaç tane daha altına ilave edersem (rakamları ve harfleri değiştirerek) daha da geliştirebilirmiyim?

 

[muygun]

Merhaba;
Elbette genişletmeniz mümkün. Ama yapacağınız genişlemede ayrı bir tetikleme düşünüyorsanız;
If Intersect(Target, [E7:E18])
Kısmında da gerekli düzenlemeyi yapın.

İyi çalışmalar.

 

[mybluecat]

Ekteki dosyada mokro kodunu 4 ve 5. tablolara veri aktarımı yapacak şekilde geliştirmek istedim.Üsttekilere benzer şekilde kodu genişlettim ama 4. tabloya veriler bir türlü gelmedi.Yeşil ile boyalı kısımda nerede hata yaptığımı bir türlü bulamadım.Birşeyi farkedemiyorum sanırım.Yardımlarınıza ihtiyacım var.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [E7:E18]) Is Nothing Then Exit Sub
Set s1 = ThisWorkbook.Worksheets(ActiveSheet.Name)
satt = Target.Row

If satt >= 7 And satt <= 9 Then
aranan = s1.Cells(satt, "e")
sat1 = 14
For k = 4 To 100
If s1.Cells(k, "l") = aranan Then
s1.Cells(sat1, "e") = s1.Cells(k, "m")
sat1 = sat1 + 1
End If
Next k
End If

If satt >= 14 And satt <= 18 Then
aranan = s1.Cells(satt, "e")
sat1 = 23
For k = 4 To 100
If s1.Cells(k, "n") = aranan Then
s1.Cells(sat1, "e") = s1.Cells(k, "o")
sat1 = sat1 + 1
End If
Next k
End If

If satt >= 14 And satt <= 18 Then
aranan = s1.Cells(satt, "e")
sat1 = 23
For k = 4 To 100
If s1.Cells(k, "p") = aranan Then
s1.Cells(sat1, "e") = s1.Cells(k, "q")
sat1 = sat1 + 1
End If
Next k
End If

If satt >= 23 And satt <= 45 Then
aranan = s1.Cells(satt, "e")
sat1 = 49
For k = 4 To 100
If s1.Cells(k, "r") = aranan Then
s1.Cells(sat1, "e") = s1.Cells(k, "s")
sat1 = sat1 + 1
End If
Next k
End If

End Sub
[/COLOR]

 

[muygun]

Merhaba;
Bu makro ancak;
[E7:E18]
aralığına konumlanırsanız çalışır.

satt = Target.Row
ile aktif hücrenin satır no'sunu alıyor.
Dolayısıyla;
If satt >= 23 And satt <= 45 Then
satt değeri asla 7 den küçük , 18 den büyük olmayacaktır.

3. satırdaki [E7:E18] değerini;
[E7:E45]
şeklinde değiştirerek deneyin.

İyi çalışmalar.

 

[mybluecat]

Teşekkür ederim.Bilmeyince en basit şeyler bile sorun oluyor.bütün akşam sebebini aradım ama bulamadım.Önemli bir sıkıntımı çözdünüz.

İyi akşamlar.