• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

ComboBox ile veri aktarma

A

Ahmet Sami

Katılım
10 Kasım 2006
Mesajlar
399
Excel Vers. ve Dili
microsoft office 2007-2010-2013-2019-2021
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
 

Ekli dosyalar

Merhaba, ANASAYFA isimli sayfanın kod bölümüne ekleyin.
Kod: 
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
 
Ö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:

PHP: 
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
 
Merhaba, alternatif örnek kod.
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
 
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.
 
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?
 
Evet MALZEME ADI na bağlı olacak oda aynı şekilde. Sizin dediğiniz gibi olacak
 
Verdiğim kodlarda Combobox1_Change kısmında End Sub satırından önce aşağıdaki satırları ekleyin:

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

ComboBox3.Column = rs.getrows
 
İ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 :o
 
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.
 
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
 
Güzel sözleriniz için teşekkürler :)

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


PHP: 
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
 
Yusuf bey hata vermedi ama ComboBox1 açılmadı verileri görmüyor.
 
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ı:

PHP: 
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
 
Evet öyle yapmışım şimdi oldu teşekkür ederim sağolun
 
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.
 
Denemeden bir şey diyemem ama başka sayfaya geçip sonra ilgili sayfayı açmayı deneyin.
 
Denedim başka bir sayfaya gidip gelince açıyor.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst