Belli bir tabloda aynı değere sahip kişileri yeni tabloda listeleme

[semihozturk1987]

Arkadaşlar anlatmak istediğim durum,

Örneğin 1. tablo

ali 1
veli 1
ahmet 2
osman 3
mehmet 2
ayşe 3
fatma 2
vs vs şeklinde bir tablom var.

Ben şimdi bunu filtreleme yöntemiyle değil de örneğin yan tarafta hazırladığım başka bir tabloda 2 değerini girdiğimde, önceki ana listeden 2 olanların bir liste oluşturmasını istiyorum. ana tabloyu filtrelediğimdeki listenin aynısı bir anlamda. Düşeyara olayıyla 1e ait kişiyi bulduruyorum ama sonuçta altta da 1 olarak tekrar ali giriyor.

Bu konuda yardım edebilecek biri çıkarsa çok sevinirim.

 

[lark]

Pivot table tam da sizin istediğinizi yapıyor. Bu iş için başka bir koda gerek yok.

 

[semihozturk1987]

Teşekkür ederim. Hemen ona bakıyorum o zaman

Pivot tabloyu inceledim fakat sonrasında benim veriyi kullanmam daha zor olur. Ben yukarıdaki tablonun çok daha büyük kısmında çalışıyorum. Örneğin a1 e 3 yazdığımda oradan çekeceği liste, başka bir tabloda sıralanması lazım ki diğer tarafta da o listenin 1. sırası şuraya 2. sırası şuraya diye doldurulacak yer var. pivotta a1den bilgi çekip bire bir her defasında farklı bilgileri benim istediğim tabloya oturtması biraz zor gibi duruyor sanki.

 

[esahin1907]

Örnek bir dosya paylaşırmısınız.

 

[semihozturk1987]

Örnek bir dosya paylaşırmısınız.

Buyrun örnek hazırladım bir tane.

 

[Erdem Akdemir]

Merhaba,

Makro ile çözüm,

Sub deneme()
Range("g3:g9").ClearContents

Set con = VBA.CreateObject("adodb.Connection")

con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=no"""

sorgu = "select distinct f1 from[sayfa1$] where f2=" & Range("e2") & " "

Set rs = con.Execute(sorgu)

Range("g3").CopyFromRecordset rs

End Sub

 

[Erdem Akdemir]

Formül ile çözüm isterseniz, dizi formülüdür.

=İNDİS($A$3:$A$12;KÜÇÜK(BÜYÜK(($B$3:$B$12=$E$2)*SATIR($B$3:$B$12)-2;SATIR(DOLAYLI("1:"&TOPLA.ÇARPIM(--($B$3:$B$12=$E$2)))));SATIR(A1)))

 

[semihozturk1987]

Merhaba,

Makro ile çözüm,

Sub deneme()
Set con = VBA.CreateObject("adodb.Connection")

con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=no"""

sorgu = "select distinct f1 from[sayfa1$] where f2=" & Range("e2") & " "

Set rs = con.Execute(sorgu)

Range("g3").CopyFromRecordset rs

End Sub

Tek kelimeyle muhteşem oldu. ne kadar teşekkür etsem azdır. Yalnız bir iki sorun var. Örneğin 2 yazdığımda 4 kişi çıkıyor. 4. olan veli. sonra tekrar 1 yazıyorum. 1de 3 kişi olduğu için onlar değişiyor ama 4. olan veli orada kalıyor değişmiyor.

 

[Erdem Akdemir]

Merhaba,

Kodun başına ekleyin. Birleştirilmiş hücreleri çözerek,temizleme alanını değiştirebilirsiniz.

Range("g3:g9").ClearContents

 

[semihozturk1987]

Merhaba,

Kodun başına ekleyin. Birleştirilmiş hücreleri çözerek,temizleme alanını değiştirebilirsiniz.

Range("g3:g9").ClearContents

tekrar tekrar çok teşekkür ederim. Dediğiniz gibi sorun çözüldü. Şimdi bir şey sormak istiyorum size merak ettiğim için. normalde soldaki tablodan bilgileri çektiniz. Ben bunu başka bir yerde kullanacağım örneğin. siz Sorgu olayını rs yaptınız, gerisini de rs ile iliştirdiniz baktığım kadarıyla. Peki ben bunu başka bir tane 1000 kişilik tabloya aldığım zaman, hatta başka bir sekmede olan ve hatta 1 2 3 yazan kısımların 4. 5. sütunda olduğu, bu değişkenleri birleştirmek için sizin makroda nereleri değiştirmem lazım. Sekme olayını büyük ihtimal formüldeki sayfa 1 kısmından halletcem gibi ama tabloyu seçtiğimiz kısmı göremedim maalesef

 

[Erdem Akdemir]

Merhaba,

F1 A kolonunu ifade ediyor.

Gerçek dosyanızı da görmek lazım, verdiğim kod tamamen eklediğiniz dosyaya göre hazırlanmış.

Kendi uyarladığınız dosyada çalışmayabilir.

 

[semihozturk1987]

Kendi kendime sanki çözdüm gibi de daha basit bir sorum olacak şimdi, örneğin f2 değerini arayıp bulduğu noktada f1i çekiyor ya, aynı zamanda f3ü de arayıp oradan da f1leri çekse diye düşündüğümüzde nasıl olur. yani örneğin 3. sütun da olsa 1 2 3 rakamlarından oluşan. iki sütundan birinde 1 gördüğünde ilk sütundaki ismi çekmiş olsa.

 

[semihozturk1987]

Merhaba,

F1 A kolonunu ifade ediyor.

Gerçek dosyanızı da görmek lazım, verdiğim kod tamamen eklediğiniz dosyaya göre hazırlanmış.

Kendi uyarladığınız dosyada çalışmayabilir.

evet a kolonuymuş. üzerinde deneye deneye yaptım bir şeyler. valla üzerinde çalıştığım dosya o kadar büyük ki, belli bir bölümünü çekmeye çalışayım izin verirseniz. ona göre ekleyeyim. tekrar tekrar sizi de uğraştırmayayım.

 

[Erdem Akdemir]

Kendi kendime sanki çözdüm gibi de daha basit bir sorum olacak şimdi, örneğin f2 değerini arayıp bulduğu noktada f1i çekiyor ya, aynı zamanda f3ü de arayıp oradan da f1leri çekse diye düşündüğümüzde nasıl olur. yani örneğin 3. sütun da olsa 1 2 3 rakamlarından oluşan. iki sütundan birinde 1 gördüğünde ilk sütundaki ismi çekmiş olsa.

sorgu kısmını aşağıdaki değiştirmek gerekir. Distinct ifadesi benzersiz getirir, aynı isimden sadece 1 kere gelir. Benzersiz istemiyorsanız distinct yazısını silebilirsiniz.

sorgu = "select distinct f1 from[sayfa1$] where f2=" & Range("e2") & "  or f3=" & Range("e2") & " "

 

[semihozturk1987]

Merhaba,

F1 A kolonunu ifade ediyor.

Gerçek dosyanızı da görmek lazım, verdiğim kod tamamen eklediğiniz dosyaya göre hazırlanmış.

Kendi uyarladığınız dosyada çalışmayabilir.

Eklediğim dosya benim ana dosyamda yaklaşık 25 sekmeden 2 tanesi. bize gerekli olan kısım. formülasyonun aynısını geçirdiğimde olur galiba.sekme isimlerini de aynı yaptım o yüzden.
Bana lazım olan personel eğitim listelerinde ad soyadlar olacak örnekteki gibi. Daha sonra farklı farklı bölümler var sağa doğru. mesela sizin 5 mayısta aldığınız eğitim tarihini e sütununa yazmışken benim 5 mayısta aldığım eğitim 2. eğitimim olduğu için j sütununa yazılabilir.

ama en genelinde sizin yaptığınız olayla ben katılım belgesi sekmesinde eğitim tarihi yerine 5 mayıs yazdığımda hemen yanındaki boş liste kısmında hem sizin hem benim adım görünmeli. yani ikimizin de bir şekilde o 5 mayıs tarihli eğitimi aldığımız belli olmalı.

bunun gibi tabi ilk sekmede 9 10 tane tarih sütunu var. onları da eklemek istiyordum. herhangi bir tarih sütununda 5 mayısı yakalamaya çalışacaktı.

 

[Erdem Akdemir]

Merhaba,

Ekteki dosyayı inceleyiniz.

Katılım belgesi sayfasındaki e sütunundaki birleştirilmiş hücreyi kaldırdım.Eğitim Tarihi G3 hücresine gelmiş oldu.

Sub deneme()

Sheets(2).Range("e2:e10000").ClearContents

Set con = VBA.CreateObject("adodb.Connection")

con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=no"""

For i = 5 To Sheets(1).Range("b4").End(xlToRight).Column Step 5
 
a = "f" & i

sorgu = "select f2 from[Personel Eğitim Listeleri$A5:AW50000] where cdate(" & a & ") ='" & Sheets(2).Range("g3") & "' and not isnull(" & a & ") "

Set rs = con.Execute(sorgu)

son = Sheets(2).Cells(Rows.Count, "e").End(3).Row + 1
Sheets(2).Range("e" & son).CopyFromRecordset rs
Set rs = Nothing

Next

End Sub

 

[semihozturk1987]

Merhaba,

Ekteki dosyayı inceleyiniz.

Katılım belgesi sayfasındaki e sütunundaki birleştirilmiş hücreyi kaldırdım.Eğitim Tarihi G3 hücresine gelmiş oldu.

Sub deneme()

Sheets(2).Range("e2:e10000").ClearContents

Set con = VBA.CreateObject("adodb.Connection")

con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=no"""

For i = 5 To Sheets(1).Range("b4").End(xlToRight).Column Step 5
 
a = "f" & i

sorgu = "select f2 from[Personel Eğitim Listeleri$A5:AW50000] where cdate(" & a & ") ='" & Sheets(2).Range("g3") & "' and not isnull(" & a & ") "

Set rs = con.Execute(sorgu)

son = Sheets(2).Cells(Rows.Count, "e").End(3).Row + 1
Sheets(2).Range("e" & son).CopyFromRecordset rs
Set rs = Nothing

Next

End Sub

Tam olarak istediğim buydu. çok teşekkür ederim. Ellerinize sağlık