Listbox a sorgu sonuçlarının listelenmesi

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

Listbox a sorgu sonuçlarının listelenmesi

İleti#1)  hilmitaranci » 07 Ekm 2018 14:36

Merhabalar,

Bir excel tablosunda çalışanlarımıza verdiğimiz KKD lerin tutulduğu bir data alanımız var.
Bu alandaki verileri userform üzerinde hazırladığımız koşullara göre listbox a çekmek istiyorum.
Ancak bir türlü başaramadım.
Yardımcı olabilirseniz çok sevinirim.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
hilmitaranci
Yeni Başlamış
 
Kayıt: 07 Eyl 2015 16:43
Meslek: Özlük İşleri Şefi
Yaş: 38
İleti: 14
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İzmir

Cevap: Listbox a sorgu sonuçlarının listelenmesi

İleti#2)  şahin » 07 Ekm 2018 17:39

Ekte

kkd.rar
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
şahin
Siteye Alışmış
 
Kayıt: 30 Eyl 2016 23:24
Meslek: memur
Yaş: 29
İleti: 347
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: bursa

Cevap: Cevap: Listbox a sorgu sonuçlarının listelenmesi

İleti#3)  hilmitaranci » 07 Ekm 2018 18:15

şahin yazdı:Ekte

kkd.rar


Ustam ellerine sağlık. Tam aradığım gibi olmuş, Cevabın için çok teşekkür ederim ancak, tarih seçeneklerine göre ve aynı anda tesis seçeneğine göre listelemede fazla veri gösteriyor. Bunun önüne nasıl geçebilirim?
Kullanıcı avatarı
hilmitaranci
Yeni Başlamış
 
Kayıt: 07 Eyl 2015 16:43
Meslek: Özlük İşleri Şefi
Yaş: 38
İleti: 14
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İzmir

Cevap: Listbox a sorgu sonuçlarının listelenmesi

İleti#4)  şahin » 07 Ekm 2018 19:15

Ekte düzenledim

kkd.rar
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
şahin
Siteye Alışmış
 
Kayıt: 30 Eyl 2016 23:24
Meslek: memur
Yaş: 29
İleti: 347
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: bursa

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Cevap: Listbox a sorgu sonuçlarının listelenmesi

İleti#5)  hilmitaranci » 07 Ekm 2018 20:18

şahin yazdı:Ekte düzenledim

kkd.rar


Yardımlarınız için çok teşekkür ederim.
Sağolun.
Kullanıcı avatarı
hilmitaranci
Yeni Başlamış
 
Kayıt: 07 Eyl 2015 16:43
Meslek: Özlük İşleri Şefi
Yaş: 38
İleti: 14
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İzmir

Cevap: Cevap: Listbox a sorgu sonuçlarının listelenmesi

İleti#6)  hilmitaranci » 07 Ekm 2018 21:53

şahin yazdı:Ekte düzenledim

kkd.rar


Hocam ek bir soru daha sorabilir miyim?

Listbox da listelenmesini istemediğim bir alan olursa (tesis adı vb.) bunu listeden nasıl çıkara bilirim ve
Ek sütun ekleyecek olursam kodu nasıl genişlete bilirim?
Verilerin arasında listelemeceğim kolonları nasıl ayıklaya bilirim?
Teşekkür ederim.
Kullanıcı avatarı
hilmitaranci
Yeni Başlamış
 
Kayıt: 07 Eyl 2015 16:43
Meslek: Özlük İşleri Şefi
Yaş: 38
İleti: 14
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İzmir

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: Listbox a sorgu sonuçlarının listelenmesi

İleti#7)  şahin » 08 Ekm 2018 12:35

SQL sorgusundan yapabilirsiniz. "Module1.SQLVeriCek" kodlar

Kod: Tümünü seç
On Error Resume Next
Dim rs As Object 'ADODB.Recordset
Set con = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
con.Open "provideR=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.FullName & ";extended properties=""excel 8.0;hdr=no"""



If UserForm1.TextBox1.Text <> "" And UserForm1.TextBox2.Text <> "" And UserForm1.ComboBox1.Text <> "" Then
     sorgu1 = "select * from [Sayfa1$A2:I10000] WHERE f3 >= CLng(CDate('" & UserForm1.TextBox1.Text & "')) AND f3 <=CLng(CDate('" & UserForm1.TextBox2.Text & "')) AND f2 = '" & UserForm1.ComboBox1.Text & "'"

ElseIf UserForm1.TextBox1.Text <> "" And UserForm1.TextBox2.Text <> "" And UserForm1.ComboBox1.Text <> "" Then
     sorgu1 = "select * from [Sayfa1$A2:I10000] WHERE (f3 >= CLng(CDate('" & UserForm1.TextBox1.Text & "')) AND f3 <=CLng(CDate('" & UserForm1.TextBox2.Text & "'))) AND (f2 = '" & UserForm1.ComboBox1.Text & "')"

ElseIf UserForm1.TextBox1.Text <> "" And UserForm1.TextBox2.Text <> "" And UserForm1.ComboBox1.Text = "" Then
     sorgu1 = "select * from [Sayfa1$A2:I10000] WHERE f3 >= CLng(CDate('" & UserForm1.TextBox1.Text & "')) AND f3 <=CLng(CDate('" & UserForm1.TextBox2.Text & "')) "
     
ElseIf UserForm1.TextBox1.Text <> "" And UserForm1.ComboBox1.Text <> "" Then
      sorgu1 = "select f1,f2,f3 from [Sayfa1$A2:I10000] WHERE f3 >= CLng(CDate('" & UserForm1.TextBox1.Text & "')) AND f2 = '" & UserForm1.ComboBox1.Text & "'"
     
ElseIf UserForm1.TextBox1.Text <> "" And (UserForm1.ComboBox1.Text = "" Or UserForm1.ComboBox1.Text = "Tüm") Then
     sorgu1 = "select * from [Sayfa1$A2:I10000] WHERE f3 >= CLng(CDate('" & UserForm1.TextBox1.Text & "'))"

ElseIf UserForm1.TextBox1.Text = "" And UserForm1.ComboBox1.Text <> "" Then
     sorgu1 = "select * from [Sayfa1$A2:I10000] WHERE f2 >= '" & UserForm1.ComboBox1.Text & "'"

End If

rs.Open sorgu1, con, 1, 1
UserForm1.ListBox1.AddItem "ad"
UserForm1.ListBox1.Column = rs.GetRows

UserForm1.ListBox1.AddItem Sayfa1.Range("a1"), 0
UserForm1.ListBox1.AddItem "", 1
For baslik = 2 To 9
UserForm1.ListBox1.List(0, baslik - 1) = Sayfa1.Cells(1, baslik)
UserForm1.ListBox1.List(1, baslik - 1) = ""
Next baslik
rs.Close
Set rs = Nothing
Set con = Nothing


Busrdaki "sorgu " değilkenine atanan SQL yazısında bulunan "SELECT *" yıldız yerine istediğiniz excel sutunlarını "F1,F3,F4" gibi yazarak bu sutunların görüntülenmesini sağlayabilirsiniz, aşağdaki gibi

Kod: Tümünü seç
On Error Resume Next
Dim rs As Object 'ADODB.Recordset
Set con = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
con.Open "provideR=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.FullName & ";extended properties=""excel 8.0;hdr=no"""



If UserForm1.TextBox1.Text <> "" And UserForm1.TextBox2.Text <> "" And UserForm1.ComboBox1.Text <> "" Then
     sorgu1 = "select f1,f2,f5 from [Sayfa1$A2:I10000] WHERE f3 >= CLng(CDate('" & UserForm1.TextBox1.Text & "')) AND f3 <=CLng(CDate('" & UserForm1.TextBox2.Text & "')) AND f2 = '" & UserForm1.ComboBox1.Text & "'"

ElseIf UserForm1.TextBox1.Text <> "" And UserForm1.TextBox2.Text <> "" And UserForm1.ComboBox1.Text <> "" Then
     sorgu1 = "select f1,f2,f5 from [Sayfa1$A2:I10000] WHERE (f3 >= CLng(CDate('" & UserForm1.TextBox1.Text & "')) AND f3 <=CLng(CDate('" & UserForm1.TextBox2.Text & "'))) AND (f2 = '" & UserForm1.ComboBox1.Text & "')"

ElseIf UserForm1.TextBox1.Text <> "" And UserForm1.TextBox2.Text <> "" And UserForm1.ComboBox1.Text = "" Then
     sorgu1 = "select f1,f2,f5 from [Sayfa1$A2:I10000] WHERE f3 >= CLng(CDate('" & UserForm1.TextBox1.Text & "')) AND f3 <=CLng(CDate('" & UserForm1.TextBox2.Text & "')) "
     
ElseIf UserForm1.TextBox1.Text <> "" And UserForm1.ComboBox1.Text <> "" Then
      sorgu1 = "select f1,f2,f5 from [Sayfa1$A2:I10000] WHERE f3 >= CLng(CDate('" & UserForm1.TextBox1.Text & "')) AND f2 = '" & UserForm1.ComboBox1.Text & "'"
     
ElseIf UserForm1.TextBox1.Text <> "" And (UserForm1.ComboBox1.Text = "" Or UserForm1.ComboBox1.Text = "Tüm") Then
     sorgu1 = "select f1,f2,f5 from [Sayfa1$A2:I10000] WHERE f3 >= CLng(CDate('" & UserForm1.TextBox1.Text & "'))"

ElseIf UserForm1.TextBox1.Text = "" And UserForm1.ComboBox1.Text <> "" Then
     sorgu1 = "select f1,f2,f5 from [Sayfa1$A2:I10000] WHERE f2 >= '" & UserForm1.ComboBox1.Text & "'"

End If

rs.Open sorgu1, con, 1, 1
UserForm1.ListBox1.AddItem "ad"
UserForm1.ListBox1.Column = rs.GetRows

UserForm1.ListBox1.AddItem Sayfa1.Range("a1"), 0
UserForm1.ListBox1.AddItem "", 1
For baslik = 2 To 9
UserForm1.ListBox1.List(0, baslik - 1) = Sayfa1.Cells(1, baslik)
UserForm1.ListBox1.List(1, baslik - 1) = ""
Next baslik
rs.Close
Set rs = Nothing
Set con = Nothing


Burda f1> ad soyada, F2>Tesis adı, F5>Bot Adedi alanını temsil eder...
Kullanıcı avatarı
şahin
Siteye Alışmış
 
Kayıt: 30 Eyl 2016 23:24
Meslek: memur
Yaş: 29
İleti: 347
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: bursa

Cevap: Cevap: Listbox a sorgu sonuçlarının listelenmesi

İleti#8)  hilmitaranci » 14 Ekm 2018 21:37

şahin yazdı:SQL sorgusundan yapabilirsiniz. "Module1.SQLVeriCek" kodlar

Kod: Tümünü seç
On Error Resume Next
Dim rs As Object 'ADODB.Recordset
Set con = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
con.Open "provideR=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.FullName & ";extended properties=""excel 8.0;hdr=no"""



If UserForm1.TextBox1.Text <> "" And UserForm1.TextBox2.Text <> "" And UserForm1.ComboBox1.Text <> "" Then
     sorgu1 = "select * from [Sayfa1$A2:I10000] WHERE f3 >= CLng(CDate('" & UserForm1.TextBox1.Text & "')) AND f3 <=CLng(CDate('" & UserForm1.TextBox2.Text & "')) AND f2 = '" & UserForm1.ComboBox1.Text & "'"

ElseIf UserForm1.TextBox1.Text <> "" And UserForm1.TextBox2.Text <> "" And UserForm1.ComboBox1.Text <> "" Then
     sorgu1 = "select * from [Sayfa1$A2:I10000] WHERE (f3 >= CLng(CDate('" & UserForm1.TextBox1.Text & "')) AND f3 <=CLng(CDate('" & UserForm1.TextBox2.Text & "'))) AND (f2 = '" & UserForm1.ComboBox1.Text & "')"

ElseIf UserForm1.TextBox1.Text <> "" And UserForm1.TextBox2.Text <> "" And UserForm1.ComboBox1.Text = "" Then
     sorgu1 = "select * from [Sayfa1$A2:I10000] WHERE f3 >= CLng(CDate('" & UserForm1.TextBox1.Text & "')) AND f3 <=CLng(CDate('" & UserForm1.TextBox2.Text & "')) "
     
ElseIf UserForm1.TextBox1.Text <> "" And UserForm1.ComboBox1.Text <> "" Then
      sorgu1 = "select f1,f2,f3 from [Sayfa1$A2:I10000] WHERE f3 >= CLng(CDate('" & UserForm1.TextBox1.Text & "')) AND f2 = '" & UserForm1.ComboBox1.Text & "'"
     
ElseIf UserForm1.TextBox1.Text <> "" And (UserForm1.ComboBox1.Text = "" Or UserForm1.ComboBox1.Text = "Tüm") Then
     sorgu1 = "select * from [Sayfa1$A2:I10000] WHERE f3 >= CLng(CDate('" & UserForm1.TextBox1.Text & "'))"

ElseIf UserForm1.TextBox1.Text = "" And UserForm1.ComboBox1.Text <> "" Then
     sorgu1 = "select * from [Sayfa1$A2:I10000] WHERE f2 >= '" & UserForm1.ComboBox1.Text & "'"

End If

rs.Open sorgu1, con, 1, 1
UserForm1.ListBox1.AddItem "ad"
UserForm1.ListBox1.Column = rs.GetRows

UserForm1.ListBox1.AddItem Sayfa1.Range("a1"), 0
UserForm1.ListBox1.AddItem "", 1
For baslik = 2 To 9
UserForm1.ListBox1.List(0, baslik - 1) = Sayfa1.Cells(1, baslik)
UserForm1.ListBox1.List(1, baslik - 1) = ""
Next baslik
rs.Close
Set rs = Nothing
Set con = Nothing


Busrdaki "sorgu " değilkenine atanan SQL yazısında bulunan "SELECT *" yıldız yerine istediğiniz excel sutunlarını "F1,F3,F4" gibi yazarak bu sutunların görüntülenmesini sağlayabilirsiniz, aşağdaki gibi

Kod: Tümünü seç
On Error Resume Next
Dim rs As Object 'ADODB.Recordset
Set con = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
con.Open "provideR=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.FullName & ";extended properties=""excel 8.0;hdr=no"""



If UserForm1.TextBox1.Text <> "" And UserForm1.TextBox2.Text <> "" And UserForm1.ComboBox1.Text <> "" Then
     sorgu1 = "select f1,f2,f5 from [Sayfa1$A2:I10000] WHERE f3 >= CLng(CDate('" & UserForm1.TextBox1.Text & "')) AND f3 <=CLng(CDate('" & UserForm1.TextBox2.Text & "')) AND f2 = '" & UserForm1.ComboBox1.Text & "'"

ElseIf UserForm1.TextBox1.Text <> "" And UserForm1.TextBox2.Text <> "" And UserForm1.ComboBox1.Text <> "" Then
     sorgu1 = "select f1,f2,f5 from [Sayfa1$A2:I10000] WHERE (f3 >= CLng(CDate('" & UserForm1.TextBox1.Text & "')) AND f3 <=CLng(CDate('" & UserForm1.TextBox2.Text & "'))) AND (f2 = '" & UserForm1.ComboBox1.Text & "')"

ElseIf UserForm1.TextBox1.Text <> "" And UserForm1.TextBox2.Text <> "" And UserForm1.ComboBox1.Text = "" Then
     sorgu1 = "select f1,f2,f5 from [Sayfa1$A2:I10000] WHERE f3 >= CLng(CDate('" & UserForm1.TextBox1.Text & "')) AND f3 <=CLng(CDate('" & UserForm1.TextBox2.Text & "')) "
     
ElseIf UserForm1.TextBox1.Text <> "" And UserForm1.ComboBox1.Text <> "" Then
      sorgu1 = "select f1,f2,f5 from [Sayfa1$A2:I10000] WHERE f3 >= CLng(CDate('" & UserForm1.TextBox1.Text & "')) AND f2 = '" & UserForm1.ComboBox1.Text & "'"
     
ElseIf UserForm1.TextBox1.Text <> "" And (UserForm1.ComboBox1.Text = "" Or UserForm1.ComboBox1.Text = "Tüm") Then
     sorgu1 = "select f1,f2,f5 from [Sayfa1$A2:I10000] WHERE f3 >= CLng(CDate('" & UserForm1.TextBox1.Text & "'))"

ElseIf UserForm1.TextBox1.Text = "" And UserForm1.ComboBox1.Text <> "" Then
     sorgu1 = "select f1,f2,f5 from [Sayfa1$A2:I10000] WHERE f2 >= '" & UserForm1.ComboBox1.Text & "'"

End If

rs.Open sorgu1, con, 1, 1
UserForm1.ListBox1.AddItem "ad"
UserForm1.ListBox1.Column = rs.GetRows

UserForm1.ListBox1.AddItem Sayfa1.Range("a1"), 0
UserForm1.ListBox1.AddItem "", 1
For baslik = 2 To 9
UserForm1.ListBox1.List(0, baslik - 1) = Sayfa1.Cells(1, baslik)
UserForm1.ListBox1.List(1, baslik - 1) = ""
Next baslik
rs.Close
Set rs = Nothing
Set con = Nothing


Burda f1> ad soyada, F2>Tesis adı, F5>Bot Adedi alanını temsil eder...


Hocam, bir iş seyahatinde olduğum için ancak dün bakabildim yazınıza.
Tüm yardımlarınız için çok teşekkür ederim. Ellerinize sağlık.
Kullanıcı avatarı
hilmitaranci
Yeni Başlamış
 
Kayıt: 07 Eyl 2015 16:43
Meslek: Özlük İşleri Şefi
Yaş: 38
İleti: 14
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İzmir


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: AhrefsBot, feraz, Google Adsense [Bot], Yandex[Bot] ve 4 misafir

cron
Bumerang - Yazarkafe