أبو أمين

السلام عليكم إخواني عندي طلب لو سمحتم كيف يمكن تغيير الكود حتى يخرج لي نتائج صحيحية بمعنى يبحث عن الكلمة ذاتها و لا يدمج فروعها عند البحث عن كلمة مثلا : إِذْ يخرج فقط الجمل التي تحوي هذه الكلمة وليس الجمل التي تحوي بإذنه / بإذن الخ هذا هو الكود وهو صراحة سريع غير أن النتائج غير مضبوطة Sub trans() raz Dim temoins As Boolean, mot$, p&, x&, oldmot$ Application.ScreenUpdating = False With Sheets("base ") mot = "" For Each cel In .Range("A2:A51") mot = cel.Text If mot <> "" Then firstrow = Sheets("Résultat").Cells(Rows.Count, 2).End(xlUp).Offset(1).Row Sheets("Résultat").Cells(firstrow, 1) = mot With Sheets("Résultat").Cells(firstrow, 1).End(xlUp) If mot <> oldmot Then .Value = .Value & vbCrLf & "(" & x & " fois)" End With x = 0 oldmot = mot For i = 2 To .Cells(Rows.Count, 2).End(xlUp).Row p = InStr(1, .Cells(i, 2).Value, mot) If p > 0 Then .Cells(i, 2).Characters(p, Len(mot)).Font.ColorIndex = 3 x = x + 1 .Cells(i, 2).Resize(, 6).Copy Destination:=Sheets("Résultat").Cells(Rows.Count, 2).End(xlUp).Offset(1) Debug.Print Cells(i, 2).Address(0, 0) & " position " & p p = 0 End If Next End If Next End With End Sub مع الشكر الجزيل أنا احتاجه كثيرا إخواني يمكنكم إستعمال نفس المرفقات

السلام عليكم مع الشكر الجزيل

عندي قاعدة بيانات في شيت base تحوي أكثر من 6200 سطر في A2 الى A51 توجد 50 كلمة كيف يمكنني ان ابحث عن الخمسين كلمة الواحدة تلو الاخرى ثم نسخ النتائج في شيت النتائج نتيجة تلو نتيجة ارفقت مثالا للملف مع الشكر الجزيل Copie de dindin- recherche mot-3.xlsm

السلام عليكم ورحمة الله وبركاته Sub raz() Sheets(2).Cells.Clear End Sub Sub trans() raz Dim temoins As Boolean, mot$, p&, x& With Sheets("base ") mot = .[A2].Text MsgBox mot firstrow = Sheets("Résultat").Cells(Rows.Count, 2).End(xlUp).Offset(2).Row For i = 2 To .Cells(Rows.Count, 2).End(xlUp).Row p = InStr(1, .Cells(i, 2).Value, mot) If p > 0 Then x = x + 1 .Cells(i, 2).EntireRow.Copy Destination:=Sheets("Résultat").Cells(Rows.Count, 2).End(xlUp).Offset(1).EntireRow Debug.Print Cells(i, 2).Address(0, 0) & " position " & p p = 0 End If Next MsgBox x End With 'ajout du compteur dans la cellule temoins en "A" dans "Résultat" With Sheets("Résultat").Cells(firstrow, 1).End(xlUp) .Value = .Value & vbCrLf & "(" & x & " fois)" End With End Sub هذا الكود يقوم بالبحث عن كلمة واحدة وينسخ نتيجة البحث في شيت النتائج. كيف يمكنني أن أجعله يبحث عن ٥٠ كلمة واحدة تلو الأخرى ثم ينسخ النتائج واحدة تلو الأخرى أيضا بالمحافظة على ترتيب الكلمات. الغاية هي ربح الوقت وعدم إستعمال نسخ لصق لكل كلمة على حدة نبهنا اكثر من مرة على هذا الموضوع وهو سوف تحذف المشاركة التى لا تحتوى على ملف مشروح فيه كل المطلوب بدقة

السلام عليكم رغم انني حذفت اكثر الشيتات و 3 يو زرفورم الا ان الملف لا زال يفوق 1.7 mb البرنامج يعمل بقيت بعض الأشياء التي أود إضافتها في العمود الثاني يوجد الألقاب التي يتم فرزها في كومبو بوكس اود إضافة الى جانب كل لقب عدد المرات الثي تكرر فيها في العمود ذاته . عملية الفرز تتم بنجاح فائق بقيت إضافة عدد مرات التكرار لكل لقب .

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

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

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

هذه الصورة مرفقة بعد تعديل الكود حيب ما شرحه الأخ جعفر الطريبق . فقط قفت بتعديل بسيط هنا في السطر الثالث Private Sub UserForm_Initialize() Label11.Caption = Label11.Caption & " " & DayNameArabic(Now()) Label2.Caption = DayNameArabic(Now()) Label3.Caption = Format(Now(), "dd") Label4.Caption = Format(Now(), "mm") Label5.Caption = Format(Now(), "yyyy") Label6.Caption = Format(DHijri(Now()), "dd") Label7.Caption = HijriMonth(Format(DHijri(Now), "mm")) Label8.Caption = Format(DHijri(Now()), "yyyy") End Sub لست املك في الأخير سوى الإعجاب بكل هذه القدرات وأسأل الله سبحانه أن يوفقنا حميعا إلى ما يحب و يرضى . سأقوم في المرة القادمة بشرح برنامجي الذي أنا بصدد إتمامه والذي أدعو الله أن ينفع به مسلمي فرنسا .

السلام عليكم جميعا و رحمة الله هذه الصورة مرفقة وهي ماخوذة من ملفك الذي ارفقته

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

السلام عليكم هذه اول مشاركة لي في هذا المنتدى , وانا معجب كثيرا بعباقرته سؤالي : هل يمكن عرض تاريخ اليوم في ليبل على يوزر فورم بهذا الشكل الأحد 1 محرم 1437 مع الشكر