الرجاء التعديل على هذه الفورم

[ريان أحمد]

شكرا أساتذتنا الكرام   وجزاكم الله كل خير  وجعلها في ميزان حسناتكم

 

 

 

لدي سؤال

 الرجاء شرح هذه الجزئية

Set ws = Worksheets("bd")
x = 1
ii = 0

Do Until x = 3

 

 

وهذه

 

 

Set ws = Worksheets("bd2")
x = x + 1
ii = 0
Loop

 End Sub
 

[حسين العصلوجى]

 

لو علي المشكلة يمكن حلها باستخدام نفس الكود الموجود بالمشاركة الاولي واظن ان هذا للكود لمشرفنا الغالي عبدالله باقشير

 

لكن نحن ننتظر استاذنا عبدالله لتوضيح سبب الخلل فالطريقة الثانية

 

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

H-test (4).rar

 

احسنت اخي حسين هذا ما عنيته

 

جزاك الله خيرا

 

تقبلوا تحياتي وشكري

 

الشكر لك استاذنا الغالي عبدالله باقشير ففي كل مشاركة لك تضيف لنا الجديد 

[حسين العصلوجى]

شكرا أساتذتنا الكرام   وجزاكم الله كل خير  وجعلها في ميزان حسناتكم

 

 

 

لدي سؤال

 الرجاء شرح هذه الجزئية

Set ws = Worksheets("bd")

x = 1

ii = 0

Do Until x = 3

 

 

وهذه

 

 

Set ws = Worksheets("bd2")

x = x + 1

ii = 0

Loop

 End Sub

 

الاخ / ريان 

الجزء الاول يعمل علي ان يجعل المتغير ws خاص بالورقة bd ثم يتم تنفيز جلب البيانات الي بوكس 1 ثم يقوم الجزء التاني بتغير المتغير ws الي الورقة الثانية bd2

ووضع x =1 حتي تجعل هذا السطر Me.Controls("ListBox" & x). خاص بليست بوكس 1ثم +1 ليحولها الي ليست بوكس 2

وloop للتكرار

[ريان أحمد]

شكرا جزيلا    وبارك الله فيك  وفي عمرك وفي صحتك لدي سؤال آخر كيف   أتحكم  في مثلا الليست بوكس 01  تأتي من العمود a والليس بوكس 02 تأتي من العمود s  مثلا   عمود البحث طبعا يعني الذي يحتوي على الأكواد

[حسين العصلوجى]

        If ws.Cells(i, 1) = Val(ComboBox1) Then

من هذا السطر حيث ان 1 يرمز الي العمود A

لكن انتبه فالكود يعمل علي اساس ان الكود في كلتا الصفحتين بنفس العمود

[ريان أحمد]

حسنا  سأجرب وإن لم ينجح سأصطر لجعلهم في نفس العمود

 

أستاذي كيف أعدل على الكود بحيث في اليست بوكس 1 تظهر أعمدة وفي الليت بوكس 02 تظهر أعمدة أخرى   ليس نفس الأعمدة

[حسين العصلوجى]

لعمل ذلك لابد من تعديل الكود تماما حيث يتم الغاء التكرار وعمل كود لكل ليست بوكس

[ريان أحمد]

الرجاء  منك مساعدتي في ذلك  ولك مني كل الشكر وجزاك الله كل خير

[عبدالله باقشير]

السلام عليكم

 

غير ارقام الاعمدة حسب ما تريد

Private Sub ComboBox1_Change()
Dim ws As Worksheet
Dim NdAry()
Dim i As Long, ii As Long
ListBox1.Clear
ListBox2.Clear

Set ws = Worksheets("bd")

    For i = 2 To ws.Range("a65536").End(xlUp).Row
        If ws.Cells(i, 1) = Val(ComboBox1) Then
          ii = ii + 1
            With ws
            ReDim Preserve NdAry(1 To 13, 1 To ii)
            NdAry(1, ii) = .Cells(i, 31).Value
            NdAry(2, ii) = .Cells(i, 2).Value
            NdAry(3, ii) = .Cells(i, 4).Value
            NdAry(4, ii) = .Cells(i, 5).Value
            NdAry(5, ii) = .Cells(i, 7).Value
             NdAry(6, ii) = .Cells(i, 8).Value
              NdAry(7, ii) = .Cells(i, 9).Value
              NdAry(8, ii) = .Cells(i, 17).Value
               NdAry(9, ii) = .Cells(i, 19).Value
                NdAry(10, ii) = .Cells(i, 21).Value
                NdAry(11, ii) = .Cells(i, 22).Value
                 NdAry(12, ii) = .Cells(i, 24).Value
                 NdAry(13, ii) = .Cells(i, 25).Value
        End With
         End If
    Next
     Me.ListBox1.Column = NdAry
'=========================================
ii = 0
Erase NdAry
Set ws = Worksheets("bd2")
'==================================

For i = 2 To ws.Range("a65536").End(xlUp).Row
        If ws.Cells(i, 1) = Val(ComboBox1) Then
          ii = ii + 1
            With ws
            ReDim Preserve NdAry(1 To 13, 1 To ii)
            NdAry(1, ii) = .Cells(i, 31).Value
            NdAry(2, ii) = .Cells(i, 2).Value
            NdAry(3, ii) = .Cells(i, 4).Value
            NdAry(4, ii) = .Cells(i, 5).Value
            NdAry(5, ii) = .Cells(i, 7).Value
             NdAry(6, ii) = .Cells(i, 8).Value
              NdAry(7, ii) = .Cells(i, 9).Value
              NdAry(8, ii) = .Cells(i, 17).Value
               NdAry(9, ii) = .Cells(i, 19).Value
                NdAry(10, ii) = .Cells(i, 21).Value
                NdAry(11, ii) = .Cells(i, 22).Value
                 NdAry(12, ii) = .Cells(i, 24).Value
                 NdAry(13, ii) = .Cells(i, 25).Value
        End With
         End If
    Next
     Me.ListBox2.Column = NdAry
    
'=========================================
Erase NdAry
Set ws = Nothing
 End Sub

تحياتي

[ريان أحمد]

السلام عليكم

 

 

عندما نقلت الكود إلى الفورم   ظهر الخطأ الذي في المرفق مع ملاحظة أ ن الكومبوكس لا تحتوي على أرقام الأكواد

Sans titre.rar

[عبدالله باقشير]

السلام عليكم

 

 

عندما نقلت الكود إلى الفورم   ظهر الخطأ الذي في المرفق مع ملاحظة أ ن الكومبوكس لا تحتوي على أرقام الأكواد

 

استبدل السطر

 Me.ListBox1.Column = NdAry

بهذا

If ii Then Me.ListBox1.Column = NdAry

وهذا السطر

Me.ListBox2.Column = NdAry

بهذا السطر

If ii Then Me.ListBox2.Column = NdAry

تحياتي

[ريان أحمد]

السلام عليكم

 

جربت الكود في المثال  فالليست بوكس 01  أظهرت النتائج والليست 02 لم تضهر جرب أدخل الرقم 18 في الكومبوكس وستتضح الرؤيا

 

 كذلك المومبوكس  فارغة لا تحتوي على أرقام  إلا إذا أدخلت فيها أرقام أريد في الكود قبولها من قائمة الكوممبوكس والإدخال اليدوي

H-test (4).rar

[أبو حنــــين]

السلام عليكم

اجعل الخاصية  ColumnCount تساوي 13  للستبوكس 2

اي في وضع التصميم

حدد لستبوكس2

اذهب الى الخصائص

ابحث عن الخاسية : ColumnCount

و اكتب الرقم 13

[ريان أحمد]

لقد نجحت الطريقة شكرا جزيلا وجزاك الله كل خير