ثلاثة كومبوبوكس مكملين لبعضهم اريد عدم تكرار البيانات فيهم

[أبو چيداء]

ثلاثة كومبوبوكس مكملين لبعضهم اريد عدم تكرار البيانات في الكوبموبوكس الاوسط

عدم التكرار.xlsm

[ابراهيم الحداد]

السلام عليكم ورحمة الله

استخدم هذا الكود بديلا للكود الموجود داخل الفورم

Private Sub UserForm_Activate()
Dim c As Range, Coll As New Collection
    On Error Resume Next
    For Each c In Sheets("sheet1").[A2:A5000]
        Coll.Add c.Value, c.Value
    Next c
    On Error GoTo 0
    For Each Item In Coll
        Me.ComboBox1.AddItem Item
    Next Item
    If Me.ComboBox1.Value <> "" Then
    p = p + 1
    ReDim arr(p, 1)
    arr(p, 1) = c.Offset(0, 1)
    Me.ComboBox2.AddItem arr(p, 1)
    End If
    If Me.ComboBox2.Value <> "" Then
    s = s + 1
    ReDim temp(s, 1)
    temp(s, 1) = c.Offset(0, 2)
   Me.ComboBox2.AddItem temp(s, 1)
    End If
End Sub

 

[أبو چيداء]

شكرا لك اخي ابراهيم الحداد ولكن الكود لا يعمل اي تغيير والتكرار موجود ايضا في combobox2

[ابراهيم الحداد]

السلام عليكم ورحمة الله

استخدم الاكواد الآتية و الغى كل الاكواد الموجودة لديك

Private Sub UserForm_Activate()
Dim C As Range, Coll As New Collection
    On Error Resume Next
    For Each C In Sheets("sheet1").[A2:A5000]
        Coll.Add C.Value, C.Value
    Next C
    On Error GoTo 0
    For Each Item In Coll
        Me.ComboBox1.AddItem Item
    Next Item
    
End Sub
Private Sub ComboBox2_Change()
ComboBox3.Clear
Dim C As Range
    For Each C In Sheets("sheet1").[B2:B5000]
    If Me.ComboBox2.Value <> "" Then
    If Me.ComboBox2.Value = C.Value And C.Count = 1 Then
    s = s + 1
    ReDim temp(s, 1)
    temp(s, 1) = C.Offset(0, 1)
   Me.ComboBox3.AddItem temp(s, 1)
    End If
    End If
Next
End Sub
Private Sub ComboBox1_Change()
ComboBox2.Clear
Dim C As Range
    For Each C In Sheets("sheet1").[A2:A5000]
    If Me.ComboBox1.Value <> "" Then
    If Me.ComboBox1.Value = C.Value Then
    p = p + 1
    ReDim arr(p, 1)
    arr(p, 1) = C.Offset(0, 1)
    Me.ComboBox2.AddItem arr(p, 1)
    End If
     End If
Next
End Sub

 

[Ali Mohamed Ali]

بارك الله فيك استاذ ابراهيم وزادك الله من فضله

[أبو چيداء]

شكرا لك اخي ابراهيم الحداد ولكنبعد اختيار مثلا المرحلة الاعدادية تجد في كومبوبوكس 2 الصف الثاثة مكرر مرتين انا اريد قائمة كومبوبوكس 2 ان تكون غير لا يوجد بها مكرر

عدم التكرار.xlsm