أكاديمية الصقر للتدريب

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
EM_ACC مجدى يونس-- لا تميز خلال هذه الفترة لا تميز خلال هذه الفترة بحاجة الى كود ترحيل اكسيل اسئله واجابات


أهلا وسهلا بك زائرنا الكريم في أكاديمية الصقر للتدريب، لكي تتمكن من المشاركة ومشاهدة جميع أقسام المنتدى وكافة الميزات ، يجب عليك إنشاء حساب جديد بالتسجيل بالضغط هنا أو تسجيل الدخول اضغط هنا إذا كنت عضواً .





تجميع عنصرين في عنصر بالكمبوبوكس

السلام عليكم تحياتي للجميع من فضلكم هل من الممكن تجميع عنصرين او اكثر في عنصر واحد بالكومبوبوكس [code]T3B0aW9uIEV4cGxp ..



19-06-2020 09:46 مساء
ANASS1
عضو مشارك
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-04-2018
رقم العضوية : 5696
المشاركات : 48
الجنس : ذكر
تاريخ الميلاد : 22-1-1990
يتابعهم : 1
يتابعونه : 0
قوة السمعة : 46
 offline 

السلام عليكم
تحياتي للجميع
من فضلكم هل من الممكن تجميع عنصرين او اكثر في عنصر واحد بالكومبوبوكس 
2lg6k_Sans titre
Option Explicit


Private Sub UserForm_Initialize()
Dim WS As Worksheet
Dim Plage As Range, Cell As Range
Dim c As Byte, x As Integer, y As Integer

Set WS = ThisWorkbook.Worksheets("Feuil1")
Set Plage = WS.Range("A2:A" & WS.Range("A1000").End(xlUp).Row)

Me.ComboBox1 = "TOUT"
Me.ComboBox2 = "TOUT"

Me.ListBox1.ColumnCount = 7

For Each Cell In Plage
    If Cell.Offset(0, 6) = "" Then                        'Entrée Seule
        With Me.ListBox1
        .AddItem Cell
            For c = 1 To 7
            .Column(c, x) = Cell.Offset(0, c)
            Next c
        x = x + 1
        End With
    End If
Next Cell

Me.ComboBox1.List = Array("A", "B", "TOUT")
Me.ComboBox2.List = Array("CLS", "ACC", "TOUT") 'CLS="CC"+"DD"
End Sub

Private Sub CommandButton1_Click()
Dim WS As Worksheet
Dim Plage As Range, Cell As Range
Dim c As Byte, x As Integer, y As Integer

If Me.ComboBox1.ListIndex = -1 Then Exit Sub
If Me.ComboBox2.ListIndex = -1 Then Exit Sub

Me.ListBox1.Clear

Set WS = ThisWorkbook.Worksheets("Feuil1")
Set Plage = WS.Range("A2:A" & WS.Range("A1000").End(xlUp).Row)
            
  For Each Cell In Plage
        If Cell.Offset(0, 6) = "" Then            'Entrée Seule
                If Me.ComboBox1.Value <> "TOUT" And Me.ComboBox2.Value <> "TOUT" Then
                     If Cell.Offset(0, 5) = ComboBox1.Value Then
                        If Cell.Offset(0, 4) = ComboBox2.Value Then
                            With Me.ListBox1
                            .AddItem Cell
                                For c = 1 To 7
                                .Column(c, x) = Cell.Offset(0, c)
                                Next c
                            x = x + 1
                            End With
                        End If
                    End If
                ElseIf Me.ComboBox1.Value <> "TOUT" And Me.ComboBox2.Value = "TOUT" Then
                    If Cell.Offset(0, 5) = ComboBox1.Value Then
                        With Me.ListBox1
                        .AddItem Cell
                            For c = 1 To 7
                            .Column(c, x) = Cell.Offset(0, c)
                            Next c
                        x = x + 1
                        End With
                    End If
                ElseIf Me.ComboBox1.Value = "TOUT" And Me.ComboBox2.Value <> "TOUT" Then
                    If Cell.Offset(0, 4) = ComboBox2.Value Then
                        With Me.ListBox1
                        .AddItem Cell
                            For c = 1 To 7
                            .Column(c, x) = Cell.Offset(0, c)
                            Next c
                        x = x + 1
                        End With
                    End If
                ElseIf Me.ComboBox1.Value = "TOUT" And Me.ComboBox2.Value = "TOUT" Then
                    With Me.ListBox1
                    .AddItem Cell
                        For c = 1 To 7
                        .Column(c, x) = Cell.Offset(0, c)
                        Next c
                    x = x + 1
                    End With
                End If
            End If
Next Cell
            
End Sub


لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب
 
 
  v01.xlsm   تحميل xlsm مرات التحميل :(3)
الحجم :(27.488) KB





الكلمات الدلالية
تجميع ، عنصرين ، عنصر ، بالكمبوبوكس ،


 










اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.

الساعة الآن 09:23 صباحا