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

السلام عليكم استخدم الكود ادناه للزر في فورم 1 Private Sub CommandButton1_Click() Dim i As Integer i = Int(Rnd * 4) + 1 Select Case i Case 1: UserForm2.Show Case 2: UserForm3.Show Case 3: UserForm4.Show Case 4: UserForm5.Show End Select End Sub في امان الله

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

السلام عليكم باستخدام دالة TRANSPOSE إرجاع نطاق خلايا عمودى كنطاق أفقي، أو بالعكس. يجب إدخال TRANSPOSE كصيغة صفيف في نطاق به نفس عدد الصفوف والأعمدة، على الترتيب، مثل صفيف الأعمدة والصفوف الخاصة به. استخدم TRANSPOSE لتبديل الاتجاه العمودي والأفقي لصفيف في ورقة عمل. بناء الجملة TRANSPOSE(array) Array (الصفيف) هو الصفيف أو نطاق الخلايا في ورقة العمل التي ترغب في تحويلها. يتم إنشاء تحويل الصفيف باستخدام الصف الأول للصفيف على أنه العمود الأول للصفيف الجديد، والصف الثاني للصفيف على أنه العمود الثاني للصفيف الجديد، وهكذا. ملاحظة يجب إدخال الصيغة كصيغة صفيف. قم بتحديد النطاق بدأً بخلية الصيغة. اضغط F2، ثم اضغط CTRL+SHIFT+ENTER. إذا لم يتم إدخال الصيغة كصيغة صفيف، تكون النتيجة المفردة واحداً. المرفق 2003 22.rar

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

السلام عليكم نشاطك ملحوظ ولا اجد كلمات اخرى لتشجيعك بعد ما قيل الله يعينك ويقويك تقبل تحياتي وشكري

السلام عليكم جرب هذا مختصر يعمل كوبي للورقة في ملف جديد ويحفظها Private Sub Cmd_action_Click() Dim iPath As String, Sht As String Dim wo As Workbook ''''''''''''''''''''''' iPath = ActiveWorkbook.Path & Application.PathSeparator ''''''''''''''''''''''' With Me.ListBox1 For i = 0 To .ListCount - 1 If .Selected(i) = True Then Sht = .List(i) Worksheets(Sht).Copy Set wo = ActiveWorkbook ''''''''''''''''''''''''''''''''''''' ' : حفظ الملف واغلاقه With wo .SaveAs iPath & Sht .Close False End With ''''''''''''''''''''''''''''''''''''' End If Next End With Set wo = Nothing End Sub في امان الله

السلام عليكم استخدم قائمة للاسماء بدلا من مربع النص شاهد المرفق 2003 معادلة sumif في الفورم.rar

السلام عليكم طبق الدالة SumIf في الفورم والمعيار يؤخذ من TextBox1 Me.TextBox2 = WorksheetFunction.SumIf([A4:A100], Me.TextBox1.Text, [D4:D100]) في امان الله

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

السلام عليكم بالنسبة لعمل الزرين تحديد الكل يكفيك زر CheckBox واحد لعمل ذلك اضف زر CheckBox وسميه CheckSelect واضف الكود ادناه الى الفورم Private Sub CheckSelect_Click() With Me.ListBox1 For i = 0 To .ListCount - 1 .Selected(i) = Me.CheckSelect.Value Next End With End Sub في امان الله

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

السلام عليكم استخدم الدالة SUMIF ضع هذه المعادلة في الخلية E14 واسحبه على الصفوف الاربعة =SUMIF($A$2:$A$10;D14;$L$2:$L$10) في امان الله

السلام عليكم نورت المنتدى اخي ابو حنين عسى المانع خير حفظك الله من كل مكروه

لم نفهم الطلب كيف تريد جميع المعلومات بدون استثناء وبعدين تختارها انت ؟؟؟

السلام عليكم استبدل هذا Private Sub TextBox1_Change() Me.TextBox2 = "" Me.TextBox3 = "" Me.TextBox4 = "" Set sh2 = Sheets("sheet2") LR = sh2.[A1000].End(xlUp).Row For Each cl In sh2.Range("A2:A" & LR) If Val(Me.TextBox1) = cl Then Me.TextBox2 = cl.Offset(0, 1) Me.TextBox4 = cl.Offset(0, 2) End If Next End Sub في امان الله

السلام عليكم اخي الحبيب احمد فضيله---حفظكم الله سرني مروركم العطر جزاكم الله خيرا وبارك فيكم تقبل تحياتي وشكري

السلام عليكم الشكر واصل لاخي بن عليه ائراءا للموضوع حل آخر باستخدام دالة MATCH =MATCH($N$2;OFFSET($F$2:$F$158;P3;;ROWS($F$2:$F$158)-P3);0)+P3 دالة صفيف.rar

السلام عليكم اخي الفاضل خالد القدس ---حفظكم الله سرني مروركم العطر تقبل تحياتي وشكري

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

وضح هذا الشرط لم افهمه هل تقصد القيم التي اكبر من الرقم 5 التي في العمود الاصفر ؟؟؟؟ تم تصحيح هذا في الكود التالي Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Long, ii As Long Dim NdAry() If Target.Address <> Range("a1").Address Then Exit Sub With tahar For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row If Val(.Cells(i, 19)) < 5 Then GoTo 1 If Target.Value = .Cells(i, 1).Value Then ii = ii + 1 ReDim Preserve NdAry(1 To 5, 1 To ii) NdAry(1, ii) = .Cells(i, 1).Value NdAry(2, ii) = .Cells(i, 2).Value NdAry(3, ii) = .Cells(i, 19).Value NdAry(4, ii) = .Cells(i, 4).Value NdAry(5, ii) = .Cells(i, 5).Value End If 1: Next End With If ii Then With formconto .Caption = ii .ListBox1.Clear .ListBox1.ColumnCount = 5 If ii = 1 Then .ListBox1.Column = NdAry Else .ListBox1.List = WorksheetFunction.Transpose(NdAry) End If .Show 0 End With Else MsgBox "معلومات هذا القيد غير متوفرة", vbInformation, "النتيجة" End If Erase NdAry End Sub في امان الله

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

ا السلام عليكم جزاك الله خيرا واثابك بدعائك واعطاك بمثله اضعاف مضاعفة المرفق الذي في المشاركة الاولى موجود فيه الفورم فقط غير الكود اللي في حدث الورقة تي 3 علشان يظهر الفورم غير في الخلية A1 تقبل تحياتي وشكري

السلام عليكم داله ممتازة اخي عبدالله ومعادلة رائعة اخي علي سالم بارك الله فيكم تعطي بيانات من نوع String يعني نص تقبلوا تحياتي وشكري

السلام عليكم جمعة مباركة استبدل حدث الورقة تي 3 Worksheet_Change بهذا الكود: Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Long, ii As Long Dim NdAry() If Target.Address <> Range("a1").Address Then Exit Sub With tahar For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row If Val(.Cells(i, 19)) < 5 Then GoTo 1 If Target.Value = .Cells(i, 1).Value Then ii = ii + 1 ReDim Preserve NdAry(1 To 5, 1 To ii) NdAry(1, ii) = .Cells(i, 1).Value NdAry(2, ii) = .Cells(i, 2).Value NdAry(3, ii) = .Cells(i, 19).Value NdAry(4, ii) = .Cells(i, 4).Value NdAry(5, ii) = .Cells(i, 5).Value End If 1: Next End With If ii Then With formconto .ListBox1.Clear .ListBox1.ColumnCount = 5 .ListBox1.List = WorksheetFunction.Transpose(NdAry) .Show 0 End With Else MsgBox "معلومات هذا القيد غير متوفرة", vbInformation, "النتيجة" End If Erase NdAry End Sub في امان الله

السلام عليكم ملحوظة لاخي الحبيب رجب ----حفظه الله الدالة النصية Filter تمرر البحث بجزئية من النص الذي تبحث فيه لو فرضنا ان الرقم 1 غير موجود في القائمة والرقم 11 موجود في القائمة فلو كتبت 1 ستمرره الدالة تقبل تحياتي وشكري