Combobox listelemede birden fazla olan modelleri bir dafa olarak listeleme

[sdegirmenci]

Merhaba;;
Ekli dosyamda Form üzerinde Combobox listesinden seçtiğim markaları ve modelleri sayfaya listelemekte. İstediğim ise, model sayısı birden fazla ise her modeli yalnızca marka ile birlikte bir defa listelesin.Bu konuda kod üzerinde değiklik yapmak konusunda yardımcı olabilirseniz çok sevinirim. İlginize çok teşekkür ederim. Saygılarımla.

 

[Ömer]

Merhaba,

Dosyanızdaki eski kodları silerek (2 kodu ) aşağıdaki kodları ekleyin.

Private Sub cihazmarkasıstoktakip_Change()
 
    Dim St As Worksheet, Ky As Worksheet, d As Object
    Dim i As Long, a, k, sat As Long, deg
 
    Set St = Sheets("Stok")
    Set Ky = Sheets("Kaynak")
 
    If cihazmarkasıstoktakip = "" Then Exit Sub
    
    Application.ScreenUpdating = False
    Ky.Range("A6:B" & Rows.Count).ClearContents
    Set d = CreateObject("Scripting.Dictionary")
 
    For i = 6 To St.Cells(Rows.Count, "E").End(xlUp).Row
        deg = St.Cells(i, "E") & "|" & St.Cells(i, "F")
        If St.Cells(i, "E") = cihazmarkasıstoktakip Then
            If Not d.exists(deg) Then
                d.Add deg, Nothing
            End If
        End If
    Next i
        
    a = d.keys: sat = 6
    For i = 0 To d.Count - 1
        k = Split(a(i), "|")
        Ky.Cells(sat + i, "A") = k(0)
        Ky.Cells(sat + i, "B") = k(1)
    Next i
    
    Application.ScreenUpdating = True
 
End Sub
 
Private Sub UserForm_Initialize()
 
    Dim St As Worksheet, i As Long, d As Object, a, deg
    
    Set St = Sheets("Stok")
    Set d = CreateObject("Scripting.Dictionary")
    For i = 6 To St.Cells(Rows.Count, "E").End(xlUp).Row
        deg = St.Cells(i, "E")
        If Not d.exists(deg) Then d.Add deg, Nothing
    Next i
    
    a = d.keys
    With Me.cihazmarkasıstoktakip
        .Clear
        .List = a
    End With
 
End Sub

.

 

[sdegirmenci]

Değerli Ömer Hocam, İlginize çok teşekkür ediyorum,
Aşağıdaki kod satırında jhata veriyor, tekrar bakabilirseniz memnun olurum, saygılarımla,

Dim St As Worksheet, Ky As Worksheet, d As Object, i As Long, a, k

 

[Ömer]

Atladığım değişken tanımlarını yaparak #2 numaralı mesajı yeniden düzenledim.
Tekrar deneyiniz. Yalnız eklediğiniz dosyadaki tüm kodları silmeyi atlamayın.

 

[sdegirmenci]

Hocam merhaba;
Aynı hatayı yine verdi , yazdığınız kodu eklediğim halini 1 nolu mesajda güncelledim.

 

[Ömer]

Dosyadaki eski tüm kodlarınızı silmeniz gerektiğini yazmıştım. Silmemişsiniz.