مساعدة في زيادة اعمدة الست بوكس

[nicola]

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

تحية شكر وتقدير الى جميع اساتذة المنتدى وعباقرتة

 

 

ارجوا المساعدة في زيادة اعمدة الست بوكس عند استدعاء البيانات

 

حيث اني بحثت في المنتدى ولم اجد الجواب الشافي 

او كود اخر لزيادة الاعمدة عند الاستدعاء

 

في المرفق توجد التفاصيل

ولكم جزيل الشكر والتحية

زيادة اعمدة الست بوكس.rar

[الـعيدروس]

السلام عليكم

 

جرب التعديل التالي

 

Private Sub CommandButton1_Click()
Dim V%, L_r%
Dim M
Dim Q, F, Rw
Dim Ar_r(), Ar()
Dim j&, L_rw, i&
ListBox1.Clear
On Error Resume Next
If TextBox1 = "" Then
ListBox1.Clear
Else
T = 0
M = Me.TextBox1
    With Sheet1
            L_r = .Cells(.Rows.Count, "B").End(xlUp).Row
            Set Q = .Range("B3:B" & L_r).Find(M)
            ReDim Preserve Ar_r(0 To 1000, 0 To 11)
            If Not Q Is Nothing Then
                F = Q.Address
                Do
                If WorksheetFunction.Search(M, Q, 1) = 1 Then
              Ar = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)
            For j = 0 To UBound(Ar)
               ii = Ar(j)
               Ar_r(T, j) = Q.Cells(1, ii)
            Next j
            T = T + 1
                 End If
                Set Q = .Range("B3:B" & L_r).FindNext(Q)
                Loop While Not Q Is Nothing And Q.Address <> F
            For i = 0 To UBound(Ar_r, 1)
              L_rw = 0
            For j = 0 To 11
              L_rw = Ar_r(i, j)
            Next j
              ReDim Preserve Ar_r(0 To i, 0 To j)
              Ar_r(i, j) = L_rw
            Next i
            Me.ListBox1.List = Ar_r()
            End If
    End With
      End If
End Sub

[حمادة عمر]

السلام عليكم

الاستاذ القدير / عباد

 

بارك الله فيك

روعة ...  الرووعة ... دائما كعادتك

ولكن لنا عتاب عليك

وجودك بيننا هذه الايام قليل جدا

لعل السبب خيرا ان شاء الله

ولكن نحب تواجدك الدائم بيننا

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

[أبو محمد أشرف]

محترم دوما القدير عباد

[احمد عبد الناصر]

السلام عليكم

 

تحياتي للجميع , اسعد الله اوقاتكم

 

استاذ عباد اكواد رائعة تحياتي 

 

يبدو ان لا يمكن زيادة الاعمدة بطريقة يدوية , يجب استخدام range او array كمصدر للبيانات .

 

هذه محاولة

 

 

Private Sub CommandButton1_Click()
ListBox1.ColumnCount = 12
[ba2] = [b2].Value
[ba3] = TextBox1.Text
Range("b2:m" & Range("a" & Rows.Count).End(xlUp)).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Range("ba2:ba3"), CopyToRange:=Range("bb1")
arr = Range("bb2:bn" & Range("bb" & Rows.Count).End(xlUp).Row)
ListBox1.List = arr
Range("ba1:bn" & Range("bb" & Rows.Count).End(xlUp).Row).Clear
End Sub

 

 

 

تم تعديل أبريل 5, 2013 بواسطه احمد عبد الناصر

[nicola]

الاخ الكريم عباد حفظك الله

الاخ الكريم احمد عبد الناصر حفظك الله

ماشاء الله عنكم دائما سباقين للخير ونشر العلم 

 

حلول ماشاء الله مبدعة 

ولكنها تعتمد على تسلسل الاعمدة عند الاستدعاء

وانا اريد ان اقوم بترتب محدد للاعمدة عند استدعائها 

والمرفق به الترتيب الذي اريده

ارجوا ان لا اكون قد صعبت الامر

 

بارك الله فيكم 

وزادكم الله من علمه

تم تعديل أبريل 6, 2013 بواسطه nicola

[nicola]

للرفع

[الـعيدروس]

السلام عليكم

اخي الحبيب حماده عمر

اسعدني مرورك وكلماتك الطيبه

ودنا نتواجد يوميا في منتدانا الغالي

ولاكن الظروف والشواغل وعما قريب إن شاء الله

نستعيد النشاط كما السابق

الاخ الفاضل ابو محمد اشرف

اشكرك على مرورك العطر

اخي nicola

حسب فهمي لما تريد

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

Ar = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)

على اساس 1 يعتبر العمود B

وهكذا

تحياتي

[الـعيدروس]

الاستاذ احمد عبدالناصر

كود مختصر ومتقن

بارك الله فيك

[حمادة عمر]

روووووووووووعة

استاذنا عباد

وكان الله في عونكم

[بن علية حاجي]

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

 

أخي الكريم، لم أجد حلا للمسألة سوى أن أضيف ListBox2 بجوار ListBox1 في الفورم (دون إطار)  لمتابعة  جلب بيانات الأعمدة الأخرى وذلك في انتظار ما يقدمه أحبتنا في المنتدى من حلول أخرى إضافة إلى حل أخي الحبيب أحمد عبد الناصر جازاه الله عنا كل خير...

 

أخوك بن علية

 

زيادة اعمدة الست بوكس.rar

 

 

[حمادة عمر]

السلام عليكم

الاستاذ القدير / بن علية حاجي

 

بارك الله فيك

بالفعل طريقة جميله جدا وجديدة

وفكرة اروع ... خدعة جميله ومبتكرة

 

ولكن هل لي ان اسأل لماذا يتم اغلاق اليست بوكس بالخيار Locked  ليكون  True

 

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

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

السلام عليكم

الشكر واصل لاخي الحبيب عباد..واخي النشيط احمد ناصر واخي بن عليه

 

وائراءا للموضوع

فيه مثال لعكس معطيات المصفوفة لاستثمار التغيير في البعد الاخير

ثم نستخدم الغرض .Column

لوضع المصفوفة المعكوسة في اللست

Private Sub CommandButton1_Click()
Dim Ary()
Dim LastRow As Long, v As Long
Dim c As Integer, cc As Integer
Dim M As String, f As String
Dim q As Range
''''''''''''''''''
ListBox1.Clear
M = TextBox1.Value
''''''''''''''''''
With Sheets("DB")
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    Set q = .Range("B2:B" & LastRow).Find(M)
    If Not q Is Nothing Then
        f = q.Address
        Do
        If InStr(1, q, M, vbTextCompare) = 1 Then
            v = v + 1
            ReDim Preserve Ary(1 To 12, 1 To v)
            For c = 1 To 12
                cc = Choose(c, 0, 1, 2, 3, 4, 8, 5, 9, 6, 10, 7, 11)
                Ary(c, v) = q.Offset(0, cc).Value
            Next
        End If
        Set q = .Range("B2:B" & LastRow).FindNext(q)
        Loop While Not q Is Nothing And q.Address <> f
    End If
End With
''''''''''''''''''''''''
''''''''''''''''''''''''
If v Then
    Me.ListBox1.Column = Ary
End If
Erase Ary
Set q = Nothing
End Sub
 

المرفق 2003/2010

زيادة اعمدة الست بوكس.rar

في امان الله

[حمادة عمر]

السلام عليكم

الاستاذ القدير / عبدالله باقشير

 

بارك الله فيك

روعة الروعة ... بل منتهي الرووعة

كل يوم نتعلم منك معلومة او معلومات جديدة

زادك الله من فضله ومن علمه

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

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

السلام عليكم

اخي الحبيب حماده

اسعدني فهمكم للمعلومه ومروركم العطر

جزاك ربي خيرا وبارك فيك

 

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

[احمد عبد الناصر]

السلام عليكم 

 

تحياتي للجميع , اسعد الله اوقاتكم

 

استاذنا الجليل عبد الله باقشير تعاملك مع arrays فوق الممتاز مذهل بارك الله لك و زادك من فضله و تقبل منك .

 

هذه محاولة اخرى 

 

Private Sub CommandButton1_Click()
ListBox1.ColumnCount = 12
[ba2] = [b2].Value
[ba3] = TextBox1.Text
Range("bb1:bm1") = Array([b2], [c2], [d2], [e2], [f2], [j2], [g2], [k2], [h2], [l2], [i2], [m2])
Range("b2:m" & Range("a" & Rows.Count).End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Range("ba2:ba3"), CopyToRange:=Range("bb1:bm1")
arr = Range("bb2:bm" & Range("bb" & Rows.Count).End(xlUp).Row)
ListBox1.List = arr
Range("ba1:bm" & Range("bb" & Rows.Count).End(xlUp).Row).Clear
End Sub

 

 

+زيادة اعمدة الست بوكس.rar

[nicola]

ماشاء الله 

ان الكلمات تعجز عن التعبير عندما تجمتع عملاقة المنتدى واساتذته

في طرح الافكار الجديدة والحلول المبدعة 

ما هذا الا دليل كرم وفضل اهل العلم في نشر العلم والارتقاء بمحتوى بالمنتدى 

 

 

استاذنا ومعلمنا القدير عبد الله باقشير

الاستاذ القدير احمد عبد الناصر

الاستاذ القدير عباد 

الاستاذ القدير بن علية حاجي

اخي حمادة عمر

 

تحية شكر وتقدير لكم 

بارك الله فيكم

وزادكم الله من واسع علمة

 

 

[kmgh]

السلام عليكم

كيف استطيع البحث عن اي جزء من الكلمة اذا كانت في مكان من الكلمة