ComboBox1 den ComboBox2 ye

[ipkisiyamaksosis]

Aradım taradım ama bir sonuca varamadım.:roll:

Arkadaşlar,:yardim:

Bir veri giriş programı hazırlıyorum, bu programda yapmak istediğim birşey var bir userform'um var Combobox1 ile A kolonundaki marka kodları dışında hiçbir şey girememeliyim. A kolonu B kolonu ile ilişkili olmalı yani, Combobox1 ile A kolonunda yer alan marka kodlarından bir tanesini girdiğimde bu girdiğim marka kodlarını Combobox2'ye geldiğimde B kolonunda karşılığı olan numaralar dışında hiçbir şey girilmesin istiyorum. ComboBox1 de girilen marka kodu ComboBox2 de girilen marka kodu örn: A sütununda 1763 yazan markaların B kolonunda yazan Barkodlarını girmem gerekiyor. Farklı bir barkod girilmesin.

Ekte örneğini görebilirisiniz.

Ellerinize sağlık şimdiden, Teşekkürler...

Yardımlarınızı bekliyorum...

 

[ipkisiyamaksosis]

Bana yardım edecek yok muu?

 

[ipkisiyamaksosis]

Kimse bana cevap vermeyecek miiii? Ben çok zor şeyler istiyorum galiba

 

[ipkisiyamaksosis]

Lütfen, bana yardım edecek kimse yok muu?

 

[veyselemre]

Dictionary nesnesi ile çözüm, örneği inceleyin.

Dim dic As Object
Private Sub ComboBox1_Change()
ComboBox2.List = dic(Val(ComboBox1.Text))
End Sub

Private Sub UserForm_Initialize()
a = Range("a2:b" & [a65536].End(3).Row)
Set dic = CreateObject("scripting.dictionary")
dic.CompareMode = TextCompare
For i = 1 To UBound(a, 1)
    ekle = Val(a(i, 1))
    If Not dic.Exists(ekle) Then
        ReDim w(0)
        w(0) = a(i, 2)
        dic.Add ekle, w
    Else
        w = dic(ekle)
        ReDim Preserve w(UBound(w, 1) + 1)
        w(UBound(w, 1)) = a(i, 2)
        dic(ekle) = w
    End If
Next i
If dic.Count > 0 Then ComboBox1.List = dic.Keys
End Sub

 

[ipkisiyamaksosis]

Sayın VeyselEmre,

Çok ama çok teşekkür ederim, bütün gece çözmek için forumu aradım taradım kitaptan baktım fakat bir türlü bulmamıştım.

Ellerinize sağlık.

Sormak istediğim birşey daha var

ComboBox1 de mouse ile seçmeme izin veriyor ben numeric olarak girmek istiyorum numeric bir tuşa bastığımda hata veriyor.

Debug diyorum
ComboBox2.List = dic(Val(ComboBox1.Text))
bu bölümde hata olduğunu söylüyor.

 

[veyselemre]

Elle yazacaksanız,

Bu kısmı kaldırın.

Private Sub ComboBox1_Change()
ComboBox2.List = dic(Val(ComboBox1.Text))
End Sub

Ekleyin.

Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
ComboBox2.List = dic(Val(ComboBox1.Text))
End Sub

 

[ipkisiyamaksosis]

Teşekkür ederim, ancak bir sorun var.

Ben ComboBox1 de 1763'ü girdiğimde deneme amaçlı Combobox2 ye 1763'ün B kolonunda yazmayan bir kod girdim hiçbir hata vermedi. Kabul ediyor, kabul etmemesini istiyorum ben. Combobox1 de girdiğim kod'un "B kolonunda" yanında yazan barkodların dışında bir kod girememeliyim.

Teşekkürler...

 

[veyselemre]

Niye elle girdiğinizi anlayamadım. Combobox kullanmanın amacı listeden seçmektir.

Kodlarınızı aşağıdaki ile değiştirin.

Dim dic As Object
Dim dic1 As Object
Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If dic.Exists(Val(ComboBox1.Text)) Then
    ComboBox2.List = dic(Val(ComboBox1.Text))
    Else
    MsgBox "Marka Bulunamadı, tekrar deneyin."
    Cancel = True
    ComboBox1.SetFocus
    Exit Sub
End If
dic1.RemoveAll
For Each elem In ComboBox2.List
        dic1.Add elem, 1
Next
End Sub
Private Sub ComboBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Not dic1.Exists(Val(ComboBox2.Text)) Then
    MsgBox "Barkod Bulunamadı, tekrar deneyin."
    Cancel = True
    ComboBox2.SetFocus
    Exit Sub
End If
End Sub
Private Sub UserForm_Initialize()
a = Range("a2:b" & [a65536].End(3).Row)
Set dic = CreateObject("scripting.dictionary")
dic.CompareMode = TextCompare
Set dic1 = CreateObject("scripting.dictionary")
dic1.CompareMode = TextCompare
For i = 1 To UBound(a, 1)
    ekle = Val(a(i, 1))
    If Not dic.Exists(ekle) Then
        ReDim w(0)
        w(0) = a(i, 2)
        dic.Add ekle, w
    Else
        w = dic(ekle)
        ReDim Preserve w(UBound(w, 1) + 1)
        w(UBound(w, 1)) = a(i, 2)
        dic(ekle) = w
    End If
Next i
If dic.Count > 0 Then ComboBox1.List = dic.Keys
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Set dic = Nothing
Set dic1 = Nothing
End Sub

 

[ipkisiyamaksosis]

Sayın Veyselemre,

Öncelikle çok ama çok teşekkür ederim.

Elle girmek istememin nedeni girişçinin mouse kullanmadan hızlı bir şekilde veri girişi yapabilmesidir.

Makro şöyle bir hata veriyor. Nedenin bir türlü anlamadım makro hata veriyor ama 1763 giriyorum 1777, 3030 gibi marka kodlarında hata veriyro.

Hata mesajı ektedir.

 

[ipkisiyamaksosis]

Kullandığım data ise ektedir. Yani daha önce gönderdiğim örnekti şimdi bu ekteki dosyaya makroyu ekledim. Yukarıda anlattığım gibi bir hata veriyor. Neden oluyordur.

Emekleriniz için çok ama çok teşeşkür ederim.

 

[ipkisiyamaksosis]

Pardon eklemeyi unutmuşum.

 

[veyselemre]

Merhaba,
Sorun mükerrer kayıtlarınızdan kaynaklanıyor, örneğin 1777 nolu marka için 2 tane 23475853 kodu var. Aşağıdaki kodları yerleştirin.

Dim dic As Object
Dim dic1 As Object

Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)

If ComboBox1.Text = "" Then Exit Sub
 
If dic.Exists(Val(ComboBox1.Text)) Then
    ComboBox2.List = dic(Val(ComboBox1.Text))
    Else
    MsgBox "Marka Bulunamadı, tekrar deneyin."
    Cancel = True
    ComboBox1.SetFocus
    Exit Sub
End If

dic1.RemoveAll

For Each elem In ComboBox2.List
        If Not dic1.Exists(Val(elem)) Then dic1.Add elem, 1
Next
End Sub
Private Sub ComboBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If ComboBox2.Text = "" Then Exit Sub
If Not dic1.Exists(Val(ComboBox2.Text)) Then
    MsgBox "Barkod Bulunamadı, tekrar deneyin."
    Cancel = True
    ComboBox2.SetFocus
    Exit Sub
End If
End Sub
Private Sub UserForm_Initialize()
a = Range("a2:b" & [a65536].End(3).Row)
Set dic = CreateObject("scripting.dictionary")
dic.CompareMode = TextCompare
Set dic1 = CreateObject("scripting.dictionary")
dic1.CompareMode = TextCompare
For i = 1 To UBound(a, 1)
    ekle = Val(a(i, 1))
    If Not dic.Exists(ekle) Then
        ReDim w(0)
        w(0) = a(i, 2)
        dic.Add ekle, w
    Else
        w = dic(ekle)
        ReDim Preserve w(UBound(w, 1) + 1)
        w(UBound(w, 1)) = a(i, 2)
        dic(ekle) = w
    End If
Next i
If dic.Count > 0 Then ComboBox1.List = dic.Keys
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
 ComboBox1.Text = ""
 ComboBox2.Text = ""
 Set dic = Nothing
 Set dic1 = Nothing
End Sub

 

[ipkisiyamaksosis]

Kopyaladım ve yapıştırdım fakat bu seferde ekteki gibi bir hata verdi.

 

[veyselemre]

O satırı silin deneme yapmak için yazmıştım. Silmeyi unutmuşum.

 

[ipkisiyamaksosis]

Çok ama çok teşekkür ederim. Ellerinize sağlık. Programım çok güzel bir şekilde çalışıyor.

Allah razı olsun...