• DİKKAT

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

Birbirine bağlı çalışan combobox

Katılım
25 Eylül 2009
Mesajlar
11
Excel Vers. ve Dili
excel 2003 türkçe
Arkadaşlar Merhaba;

Yapmak istediğim bişi var ama bir türlü başaramadım.

Bir kayıt sistemi düşünün. şöyleki personelin servisini ve bindiği durağı kaydedeceksiniz. ama öyle bişey olmalıki seçtiğiniz servisin durakları diğer comboboxta çıkmalı. başka servisin durağı orda olmamalı.

Konuyla ilgili örnek bir çalışma yapıp atabilir misiniz?

şimdiden teşekkürler...
 
merhaba ornek dosyayi inceleyiniz,

sayfadaki kodlar;
Kod:
Private Sub ComboBox1_Change()
Dim aralik As Range, adres As String
ComboBox2.Clear
If ComboBox1.Value = "" Then Exit Sub
Set aralik = Sheets("Servis").Range("D2:D1000").Find(ComboBox1.Value, , xlValues, xlWhole)
If Not aralik Is Nothing Then
    adres = aralik.Address
    Do
        ComboBox2.AddItem aralik.Offset(0, 1).Value
        Set aralik = Sheets("Servis").Range("D2:D65536").FindNext(aralik)
    Loop While Not aralik Is Nothing And aralik.Address <> adres
End If
If ComboBox2.ListCount > 0 Then ComboBox2.ListIndex = 0
End Sub


Private Sub Worksheet_Activate()
Call combobox_1
End Sub

moduldeki kodlar;
Kod:
Sub combobox_1()
Dim sat As Long, i As Long
Sheets("Servis").ComboBox1.Clear
sat = Sheets("Servis").Cells(1000, "D").End(xlUp).Row
For i = 2 To sat
     If WorksheetFunction.CountIf(Sheets("Servis").Range("D2:D" & i), Cells(i, "D").Value) = 1 Then
        Sheets("Servis").ComboBox1.AddItem Sheets("Servis").Cells(i, "D").Value
    End If
Next
If Sheets("Servis").ComboBox1.ListCount > 0 Then Sheets("Servis").ComboBox1.ListIndex = 0
End Sub

Sub auto_open()
Call combobox_1
End Sub

kaydirarak d2:d1000 araliginin yanindaki verileri diger comboya almaktadir, veriniz 1000 satiri geciyor ise bunu dikkate aliniz..
 

Ekli dosyalar

Merhaba,
2 den fazla combobox nasıl yapabiliriz? 3,4,5 Yardımcı olabilir misiniz?
 
Geri
Üst