birbirine bağlantılı 2 combobox

fedeal · 22 Ocak 2009

formda 2 combobox 1 textbox var. combobox la textboxa veri getirebiliyoruz benim yapmak istedigim combobox1 de tarih secince(örnegin otarihten 10 veri girişi olmuş) combobox2 o 10 hücrenin yan hücresindeki verileri listeleyebilirmi?

ENDMUH1 · 23 Ocak 2009

ıstenılen combobox degerıne gore lısteleme

Günaydın,

Userformun içerisine aşağıdaki kodu yerleştirirseniz çalışacaktır.

İyi çalışmalar...

Dim ArrSatir(1000)

Public Sub ComboBox1_Change()

Cmb1 = ComboBox1.Value
ComboBox2.Clear
For i = 2 To 50
deger = Format(Sheets("sayfa1").Cells(i, 1), "dd.mm.yyyy")
If deger = Cmb1 Then
ComboBox2.AddItem Cells(i, 2)
ArrSatir(ComboBox2.ListCount - 1) = i
End If
Next
End Sub

Public Sub ComboBox2_Change()
Sheets("sayfa1").Select
Ind = ComboBox2.ListIndex
s = ArrSatir(Ind)
TextBox1 = Cells(s, 3)
End Sub

Private Sub UserForm_Initialize()
For i = 2 To 10000
If Sheets("sayfa1").Cells(i, 1) <> "" Then
ComboBox1.AddItem Format(Sheets("sayfa1").Cells(i, 1), "dd.mm.yyyy")
End If
Next
End Sub

ENDMUH1 · 23 Ocak 2009

..

Sayın Fedeal,

Farklı günlere bakıldığında combobox2' nin içerisinin boşaltılmasındaki bug'u düzelttim...

Bunu kullanabilirsiniz..

Kolaylıklar,

Dim ArrSatir(1000)

Public Sub ComboBox1_Change()

Cmb1 = ComboBox1.Value
ComboBox2.Clear
For i = 2 To 50
deger = Format(Sheets("sayfa1").Cells(i, 1), "dd.mm.yyyy")
If deger = Cmb1 Then
ComboBox2.AddItem Cells(i, 2)
ArrSatir(ComboBox2.ListCount - 1) = i
End If
Next
End Sub

Public Sub ComboBox2_Change()

Sheets("sayfa1").Select

Ind = ComboBox2.ListIndex
If Ind <> -1 Then
s = ArrSatir(Ind)
TextBox1 = Cells(s, 3)
End If
End Sub

Private Sub UserForm_Initialize()
For i = 2 To 10000
If Sheets("sayfa1").Cells(i, 1) <> "" Then
ComboBox1.AddItem Format(Sheets("sayfa1").Cells(i, 1), "dd.mm.yyyy")
End If
Next
End Sub

Tarkan VURAL · 23 Ocak 2009

Yanıt

Merhaba;
ADO ve SQL kullanmak isterseniz eğer; size ufak bir örnek

Kod:

Dim con As Object, rs As Object

Private Sub UserForm_Initialize()
Set con = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
con.Open "provider=microsoft.jet.oledb.4.0;data source = " & ThisWorkbook.FullName & _
";extended properties = ""excel 8.0;hdr=yes"""
rs.Open "select distinct(format(tarih,'dd.mm.yyyy')) from [Sayfa1$]", con, 1, 1
Do While Not rs.EOF
ComboBox1.AddItem rs.fields(0).Value
rs.movenext
Loop
rs.Close
End Sub

Kod:

Private Sub ComboBox1_Change()
ComboBox1.Value = FormatDateTime(ComboBox1.Value, vbShortDate)
ComboBox2.Clear: ComboBox2.Text = Empty: TextBox1.Text = Empty
If rs.State = 1 Then rs.Close
rs.Open "select * from [Sayfa1$] where format(tarih,'dd.mm.yyyy') = '" & FormatDateTime(Me.ComboBox1.Value, vbShortDate) & "'", con, 1, 1
Do While Not rs.EOF
ComboBox2.AddItem rs.fields(1).Value
rs.movenext
Loop
End Sub

Kod:

Private Sub ComboBox2_Change()
If ComboBox2.Text = Empty Then Exit Sub
If rs.State = 1 Then rs.Close
rs.Open "select * from [Sayfa1$] where format(tarih,'dd.mm.yyyy') = '" & FormatDateTime(Me.ComboBox1.Value, vbShortDate) & "' and kod='" & Me.ComboBox2.Text & "'", con, 1, 1
TextBox1.Text = rs.fields(2).Value
End Sub

Onbinlerce veriniz olsun fark etmez , sonuç çok hızlı olacaktır. İsterseniz deneyip hız farklarını analiz edin

fedeal · 23 Ocak 2009

iki mükemmel cevap teşekkür ederim. emeginize saglık. ihtiyacı olan olabilir diye dosyayı ekledim.iyi calışmalar.

Tarkan VURAL · 23 Ocak 2009

Önemli değil, ben de örnekle destekleyip, incelemek isteyenlere fayda vermek istediğiniz için teşekkür ederim

rabbace · 29 Nisan 2018

Merhaba,

Ekteki dosyada hazırladığım Userform üzerinde bulunan 2 farklı combobox için bu tarz bir isteğim var. Dosya içinde anlatmaya çalıştım. Yardımcı olur musunuz?

Ömer BARAN · 29 Nisan 2018

Merhaba.

Mevcut UserForm kodlarını yazan kişi olmadığımdan diğer hususları gözden geçirmedim.
Anladığım kadarıyla Sheet2 isimli sayfada Q sütunundaki veriler sıralı durumda.

Bu sıralı olma durumundan hareketle; belirttiğiniz combo1 isimli Combobox nesnesine ait kodların
End Sub satırından önce aşağıdaki satırları eklerseniz istediğiniz olur.

Diğer nesne kodlarını da gözden geçirmeniz gerekebilir.
.

Kod:

text_yt = ""
If combo1 = "" Then
    text_yt.RowSource = Empty: Exit Sub
End If
ilk = WorksheetFunction.Match(combo1, Sheets("Sheet2").[Q:Q], 0)
son = ilk - 1 + WorksheetFunction.CountIf(Sheets("Sheet2").[Q:Q], combo1)
text_yt.RowSource = "Sheet2!T" & ilk & ":T" & son

Korhan Ayhan · 30 Nisan 2018

Eklediğiniz dosya benim notebookta garip bir şekilde yavaş çalışıyor. Uygulama yaptığım dosyanız da ektedir.

Ben alternatif olarak "Collection" özelliğini önerebilirim.

İlk olarak tasarım aşamasında "Combo1" nesnesinin "RowSource" özelliğindeki tanımlamayı temizleyin.

Formunuzun açılma olayını aşağıdaki gibi değiştirin.

Kod:

Private Sub UserForm_Initialize()
    Dim Veri As Range, Liste As Collection
    
    On Error Resume Next
    
    ActiveWorkbook.RefreshAll

    Set Liste = New Collection

    For Each Veri In Sheets("Sheet2").Range("Q2:Q1000")
        If Veri.Value <> "" Then Liste.Add Veri.Value, CStr(Veri.Value)
    Next
    
    For Each X In Liste
        combo1.AddItem X
    Next
End Sub

"Combo1" nesnesinin Change olayını aşağıdaki gibi değiştirin.

Kod:

Private Sub combo1_Change()
    Dim Veri As Range, Liste As Collection
    
    On Error Resume Next
    
    combo1 = Evaluate("=büyükharf(""" & combo1 & """)")
    combo1 = Evaluate("=upper(""" & combo1 & """)")
    
    Set Liste = New Collection

    For Each Veri In Sheets("Sheet2").Range("Q2:Q1000")
        If UCase(Replace(Replace(Veri.Value, "ı", "I"), "i", "İ")) = combo1 Then
            Liste.Add Veri.Offset(0, 3).Value, CStr(Veri.Offset(0, 3).Value)
        End If
    Next
    
    For Each X In Liste
        text_yt.AddItem X
    Next
End Sub

"text_yt" nesnesinin Change olayını aşağıdaki gibi değiştirin.

Kod:

Private Sub text_yt_Change()
    On Error Resume Next
    text_yt = Evaluate("=büyükharf(""" & text_yt & """)")
    text_yt = Evaluate("=upper(""" & text_yt & """)")

    If ComboBox1 = "" Then
        MsgBox ("Önce bölüm seçiniz!!!")
        ComboBox1.SetFocus
    End If
End Sub

Dosyanızı kayıt edip kapatıp açtıktan sonra denemeler yapın.

rabbace · 30 Nisan 2018

Ömer BARAN' Alıntı:
Merhaba.

Mevcut UserForm kodlarını yazan kişi olmadığımdan diğer hususları gözden geçirmedim.
Anladığım kadarıyla Sheet2 isimli sayfada Q sütunundaki veriler sıralı durumda.

Bu sıralı olma durumundan hareketle; belirttiğiniz combo1 isimli Combobox nesnesine ait kodların
End Sub satırından önce aşağıdaki satırları eklerseniz istediğiniz olur.

Diğer nesne kodlarını da gözden geçirmeniz gerekebilir.
.

Kod:

text_yt = "" If combo1 = "" Then text_yt.RowSource = Empty: Exit Sub End If ilk = WorksheetFunction.Match(combo1, Sheets("Sheet2").[Q:Q], 0) son = ilk - 1 + WorksheetFunction.CountIf(Sheets("Sheet2").[Q:Q], combo1) text_yt.RowSource = "Sheet2!T" & ilk & ":T" & son

Ömer bey ,

Kusursuz çalışıyor, denedim defalarca sorun çıkmadı. Diğer kodları da gözden geçireceğim.

Çok teşekkürler.

rabbace · 30 Nisan 2018

Korhan Ayhan' Alıntı:
Eklediğiniz dosya benim notebookta garip bir şekilde yavaş çalışıyor. Uygulama yaptığım dosyanız da ektedir.

Ben alternatif olarak "Collection" özelliğini önerebilirim.

İlk olarak tasarım aşamasında "Combo1" nesnesinin "RowSource" özelliğindeki tanımlamayı temizleyin.

Formunuzun açılma olayını aşağıdaki gibi değiştirin.

Kod:

Private Sub UserForm_Initialize() Dim Veri As Range, Liste As Collection On Error Resume Next ActiveWorkbook.RefreshAll Set Liste = New Collection For Each Veri In Sheets("Sheet2").Range("Q2:Q1000") If Veri.Value <> "" Then Liste.Add Veri.Value, CStr(Veri.Value) Next For Each X In Liste combo1.AddItem X Next End Sub

"Combo1" nesnesinin Change olayını aşağıdaki gibi değiştirin.

Kod:

Private Sub combo1_Change() Dim Veri As Range, Liste As Collection On Error Resume Next combo1 = Evaluate("=büyükharf(""" & combo1 & """)") combo1 = Evaluate("=upper(""" & combo1 & """)") Set Liste = New Collection For Each Veri In Sheets("Sheet2").Range("Q2:Q1000") If UCase(Replace(Replace(Veri.Value, "ı", "I"), "i", "İ")) = combo1 Then Liste.Add Veri.Offset(0, 3).Value, CStr(Veri.Offset(0, 3).Value) End If Next For Each X In Liste text_yt.AddItem X Next End Sub

"text_yt" nesnesinin Change olayını aşağıdaki gibi değiştirin.

Kod:

Private Sub text_yt_Change() On Error Resume Next text_yt = Evaluate("=büyükharf(""" & text_yt & """)") text_yt = Evaluate("=upper(""" & text_yt & """)") If ComboBox1 = "" Then MsgBox ("Önce bölüm seçiniz!!!") ComboBox1.SetFocus End If End Sub

Dosyanızı kayıt edip kapatıp açtıktan sonra denemeler yapın.

Korhan bey ilginize çok teşekkür ederim,

Dosyayı indirip kontrol ettim, ilk comboboxta değişiklik yaptığımda, 2. combobox güncellenmiyor. Dosyayı kapatıp, yeniden açtığımda 1. comboboxtan farklı bir seçenek seçersem doğru değeri getiriyor. Yani her seferinde kapatıp açmak gerekiyor userformu.

birbirine bağlantılı 2 combobox

fedeal

Banned

Ekli dosyalar

ENDMUH1

ENDMUH1

Tarkan VURAL

fedeal

Banned

Ekli dosyalar

Tarkan VURAL

rabbace

Ekli dosyalar

Ömer BARAN

Uzman

Korhan Ayhan

Administrator

Ekli dosyalar

rabbace

rabbace