ComboBox ile veri aktarma

[Ahmet Sami]

Kıymetli abilerim, sizlerin yardımına ihticım var. Şöyle ki D4 te bulunan ComboBox1 tan veri seçtiğim zaman VERİ sayfasında bulunan seçtiğim malzemenin SERİ NUMARAlarını getirmesi.
Örnek olarak FIBER PATCH PANEL i seçtiğim zaan VERİ sayfasından ilgili malzemenin seri numaralırının ComboBox2 de görülmesi. Bu diğer malzemeler içinde geçerli olacak

 

[veyselemre]

Merhaba, ANASAYFA isimli sayfanın kod bölümüne ekleyin.

Private Sub ComboBox1_Change()
    ComboBox2.Clear
    veri = Sheets("VERİ").Range("B2:C" & Sheets("VERİ").Cells(Rows.Count, 1).End(3).Row).Value

    For i = LBound(veri) To UBound(veri)
        If veri(i, 1) = ComboBox1.Text Then
            ComboBox2.AddItem veri(i, 2)
        End If
    Next i

End Sub

 

[YUSUF44]

Öncelikle Combobox1'in Listfillrange özelliğini iptal edin yani boş bırakın.

Aşağıdaki kodları ANASAYFA sayfasının kod bölümüne (sayfa adına sağ tıklayıp kod görüntüle deyince açılan sayfaya yapıştırın:

Private Sub ComboBox1_Change()

Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "select [SERİ NO] from [VERİ$] where [MALZEME ADI]='" & ComboBox1.Value & "'"
Set rs = con.Execute(sorgu)

ComboBox2.Column = rs.getrows

End Sub

Private Sub Worksheet_Activate()
Set s1 = Sheets("VERİ")
son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "A").End(3).Row)

Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "select distinct [MALZEME ADI] from [VERİ$] where [MALZEME ADI] is not null"
Set rs = con.Execute(sorgu)

ComboBox1.Column = rs.getrows

End Sub

 

[Ahmet Sami]

Yusuf ve Veysel bey çok teşekkür ederim.

 

[AdemCan]

Merhaba, alternatif örnek kod.

Private Sub ComboBox1_Change()
Application.ScreenUpdating = False
Dim s1 As Worksheet, s2 As Worksheet

Set s1 = Sheets("ANASAYFA"): Set s2 = Sheets("VERİ")
malzeme = ComboBox1.Value

If malzeme = "" Then
    ComboBox2.Clear
    Exit Sub
End If

say = WorksheetFunction.CountIf(s2.Range("B:B"), malzeme)
If say > 0 Then
    bul = s2.Range("B:B").Find(malzeme).Row
    ComboBox2.Clear
    For i = bul To bul + say - 1
        ComboBox2.AddItem s2.Cells(i, "C")
    Next i
End If

Application.ScreenUpdating = True
End Sub

 

[Ahmet Sami]

Kıymetli üstadlarım emeklerinize sağlık teşekkür ederim.
Yusuf bey şuan için acil değil ama A sütununda bulunan STOK NO lar için üçüncü ComboBox3 u tanımlayabilir miyiz. Ben deneme yaparak kodun içerisine yapmaya çalıştım ama hata verdi olmadı.
Size zahmet verecekse sizi yormak istemem. Sadece kodun içerisine nasıl eklenir onu bilemedim.

 

[YUSUF44]

Bahsettiğiniz combobox diğer comboboxlarla bağlantılı mı çalışacak? Yani önce malzeme adı, sonra seri no sonra da barkod no mu seçilecek?

 

[Ahmet Sami]

Evet MALZEME ADI na bağlı olacak oda aynı şekilde. Sizin dediğiniz gibi olacak

 

[YUSUF44]

Verdiğim kodlarda Combobox1_Change kısmında End Sub satırından önce aşağıdaki satırları ekleyin:

sorgu = "select [BARKOD NO] from [VERİ$] where [MALZEME ADI]='" & ComboBox1.Value & "'"
Set rs = con.Execute(sorgu)

ComboBox3.Column = rs.getrows

 

[Ahmet Sami]

Çoooook Teşekkür ederim Yusuf bey iyi ki varsınız.

 

[YUSUF44]

İyi ki var mıyım bilmiyorum, geçen gün bi kullanıcı nerdeyse her sorusuna cevap verip sorununu çözdüğüm halde benden "illallah" etmişti

 

[Ahmet Sami]

Biz sizi seviyoruz Allah için, ayinesi iştir kişinin lafa bakılmaz. Bende bir kullanıcıyım bizim için fedakarlık yapıyorsunuz. Sizden bir cevap gelmiyorsa mutlaka bizim ne istediğimizi bilemememizden kaynaklandığına eminim.

 

[Ahmet Sami]

Bu arada sayenizde güzel bir çalışma çıktı Allah razı olsun.
Bir şey daha rica etsem mümkünmüdür. Birde sıralı olarak seçme şansımız varmı. Tersten gidecek olursak. ComboBox3'ü ComboBox2'ye göre ComboBox2'yi ComboBox1'e göre bağlantılı olarak seçim yaptırabilir miyiz. Sırasına göre olacak doğru taraftan gidersekte ComboBox1'i seçersem ComboBox2 seçilecek, ComboBox2 yi seçince de ComboBox2 ye göre üç seçilecek

 

[YUSUF44]

Güzel sözleriniz için teşekkürler

Eski change kodlarını silip aşağıdakileri deneyin:

Private Sub ComboBox1_Change()
Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "select [SERİ NO] from [VERİ$] where [MALZEME ADI]='" & ComboBox1.Value & "'"
Set rs = con.Execute(sorgu)
If Not rs.EOF And Not rs.bof Then
    ComboBox2.Clear
    ComboBox3.Clear
    ComboBox2.Column = rs.getrows
End If
End Sub

Private Sub ComboBox2_Change()
Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "select [BARKOD NO] from [VERİ$] where [MALZEME ADI]='" & ComboBox1.Value & "' and [SERİ NO]='" & ComboBox2.Value & "'"
Set rs = con.Execute(sorgu)
If Not rs.EOF And Not rs.bof Then
    ComboBox3.Clear
    ComboBox3.Column = rs.getrows
End If
End Sub

 

[Ahmet Sami]

Yusuf bey hata vermedi ama ComboBox1 açılmadı verileri görmüyor.

 

[YUSUF44]

Siz eski tüm kodları silmişsiniz muhtemelen. Ben sadece Change olan kodu silmenizi istemiştim. Activate olan kod kalmalıydı. Yani son hali şöyle olmalı:

Private Sub ComboBox1_Change()
Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "select [SERİ NO] from [VERİ$] where [MALZEME ADI]='" & ComboBox1.Value & "'"
Set rs = con.Execute(sorgu)
If Not rs.EOF And Not rs.bof Then
    ComboBox2.Clear
    ComboBox3.Clear
    ComboBox2.Column = rs.getrows
End If
End Sub

Private Sub ComboBox2_Change()
Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "select [BARKOD NO] from [VERİ$] where [MALZEME ADI]='" & ComboBox1.Value & "' and [SERİ NO]='" & ComboBox2.Value & "'"
Set rs = con.Execute(sorgu)
If Not rs.EOF And Not rs.bof Then
    ComboBox3.Clear
    ComboBox3.Column = rs.getrows
End If
End Sub

Private Sub Worksheet_Activate()
Set s1 = Sheets("VERİ")
son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "A").End(3).Row)

Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "select distinct [MALZEME ADI] from [VERİ$] where [MALZEME ADI] is not null"
Set rs = con.Execute(sorgu)

ComboBox1.Column = rs.getrows

End Sub

 

[Ahmet Sami]

Evet öyle yapmışım şimdi oldu teşekkür ederim sağolun

 

[Ahmet Sami]

Yusuf bey hayırlı günler. Dün farketmedim akşam çıkarken dosyayı kaydedip çıktım. Sabah gelince açtım ancak ComboBox'lar çalışmadı ancak kod bölümüne girerek oradaki çalıştır tuşuna bastıktan sonra ComboBox'lar çalışıyor. Nasıl düzeltebilirim yardım etme imkanınız varmıdır.

 

[YUSUF44]

Denemeden bir şey diyemem ama başka sayfaya geçip sonra ilgili sayfayı açmayı deneyin.

 

[Ahmet Sami]

Denedim başka bir sayfaya gidip gelince açıyor.