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

اخي شوقي ربيع

السلام عليكم شاهد المرفق 2010 DATA++.rar

اخي عبد الرحمن شفيق

اخي احمد النجار

استبدل بدلا من الرقم 1000 الطول الحقيقي للكشف عندك Private Sub ButtonSaveFil_Click() Dim iC As Integer iC = Me.ListFind.ListCount If iC = 0 Then GoTo 1 '------------------------ Application.ScreenUpdating = False With Sheets(3) .Select .Range("A6").Resize(1000, ContColmn).ClearContents .Range("A6").Resize(iC, ContColmn).Value = Me.ListFind.List End With Application.ScreenUpdating = True Unload Me 1 End Sub تحياتي

هذه الدالة تقوم بذلك Option Explicit Function kh_vCont11(Rng As Range) As Long Dim Col As New Collection Dim Tx, iText, v ''''''''''''''''''''''''''''' On Error Resume Next For Each v In Rng.Cells For Each Tx In Split(CStr(v), ",") Col.Add 1, Trim(Tx) Next Next kh_vCont11 = Col.Count Set Col = Nothing On Error GoTo 0 End Function شاهد المرفق 2003 example++.rar

السلام عليكم اخي الحبيب حمادة عمر ...........حفطكم الله والله انني استحي من الرد عليكم..لاني لا اجد ما ارد به مقابل هذا الكرم اكرمكم الله في الدنيا والآخرة وجزاكم خيرا واثابكم بدعائكم واعطاكم بمثله اضعاف مضاعفة تقبلوا تحياتي وشكري

السلام عليكم جزاكم الله خيرا هذا طلبك ولكن عدد الاعمدة 21 وليس 20 ' عدد الاعمدة Const Cont As Integer = 21 Private Sub ButtonFind_Click() Dim Ary() Dim r As Long, rr As Long, Lr As Long Dim c As Integer, cc As Integer Dim txt As String txt = Me.TextFind Me.ListBox1.Clear With Sheets("البيانات") Lr = .Cells(.Rows.Count, "A").End(xlUp).Row For r = 2 To Lr If InStr(CStr(.Cells(r, "A")), txt) Then rr = rr + 1 ReDim Preserve Ary(1 To Cont, 1 To rr) For c = 1 To Cont cc = Choose(c, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25) Ary(c, rr) = .Cells(r, cc).Value Next End If Next End With If rr Then Me.ListBox1.Column = Ary Erase Ary End Sub تقبلوا تحياتي وشكري

السلام عليكم جزاكم الله خيرا تقبلوا تحياتي وشكري

هذا المرفق فقط لاريك صيغة الكود المستخدم في مثل هذه الحالات وليس كعمل معين بحد ذاته. تقبلوا تحياتي وشكري

السلام عليكم ورحمة الله وبركاته احسنت وجزاكم الله خيرا تقبلوا تحياتي وشكري

السلام عليكم جزاكم الله خيرا تقبلوا تحياتي وشكري

جزاكم الله خيرا تقبلوا تحياتي وشكري

استبدل السطر Me.ListBox1.Column = NdAry بهذا If ii Then Me.ListBox1.Column = NdAry وهذا السطر Me.ListBox2.Column = NdAry بهذا السطر If ii Then Me.ListBox2.Column = NdAry تحياتي

السلام عليكم جزاكم الله خيرا تقبلوا تحياتي وشكري

السلام عليكم جزاكم الله خيرا تقبلوا تحياتي وشكري

السلام عليكم جزاكم الله خيرا تقبلوا تحياتي وشكري

السلام عليكم جزاكم الله خيرا تقبلوا تحياتي وشكري

السلام عليكم جزاكم الله خيرا تقبلوا تحياتي وشكري

السلام عليكم الشكر واصل لخي الجبيب جمال واخي الحبيب رجب ..........حفظهما الله لاثراء الموضوع هذه دالة بالكود Option Explicit Function kh_vCont(iText) As Long Dim Obj As Object, Tx ''''''''''''''''''''''''''''' Set Obj = CreateObject("Scripting.Dictionary") ''''''''''''''''''''''''''''' For Each Tx In Split(iText, ",") If Not Obj.Exists(Trim(Tx)) Then Obj.Add Trim(Tx), 1 End If Next kh_vCont = Obj.Count Set Obj = Nothing End Function المرفق 2003 دالة عدد الأرقام الفريدة في نص.rar

السلام عليكم إضافة اكثر من 10 اعمدة الى اللست بوكس وخاصة عند البحث الملاحظ دائما عند اضافة قيم الى اللست بوكس يستخدم الغرض AddItem لكن عندما تكون الاعمدة اكثر من 10 اعمدة يظهر خطأ وهذا البديل وهواسرع وافضله حتى ولو كانت الاعمدة لا تتجاوز 10 اعمدة الملف 2003 ListBox.rar

السلام عليكم جزاكم الله خيرا تقبلوا تحياتي وشكري

السلام عليكم غير ارقام الاعمدة حسب ما تريد 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 تحياتي