ياسر خليل أبو البراء

جرب الكود التالي Sub Add_Rows() Dim I As Long Application.ScreenUpdating = False Application.Calculation = xlCalculationManual With ActiveSheet I = ActiveSheet.UsedRange.Rows.Count For I = .Cells.SpecialCells(xlLastCell).Row To 6 Step -1 If Len(Trim(Cells(I, 2))) <> 0 Then Rows(I).Insert Next I Rows(.Cells.SpecialCells(xlLastCell).Row).Copy Rows(.Cells.SpecialCells(xlLastCell).Row + 1).PasteSpecial Paste:=xlPasteFormats End With Application.CutCopyMode = False Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub Sub Delete_Rows() Dim I As Long Application.ScreenUpdating = False Application.Calculation = xlCalculationManual I = ActiveSheet.UsedRange.Rows.Count For I = Cells.SpecialCells(xlLastCell).Row To 6 Step -1 If Len(Trim(Cells(I, 2))) = 0 Then Rows(I).Delete Next I Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub تقبل تحياتي

الحمد لله الذي بنعمته تتم الصالحات جزيت خيراً أخي العزيز وائل على دعائك الطيب المبارك ، ولك بمثل إن شاء الله أحبك الله الذي أحببتنا فيه ********** لو إنت فهمت اللوغاريتمات والكل فهم ، يبقا أبشر .. مفيش حد هيكون عنده مشاكل واحتمال المنتدى يقفل وكل واحد يروح بيته إن شاء الله بالصبر والعزيمة والإرداة للتعلم تصل إلى مبتغاك .. وأنا لست إلا متعلم مجتهد تقبل تحياتي

أخي الكريم وائل جرب الملف المرفق Sub Search_Using_Arrays() Dim Arr, Temp, I As Long, Counter As Long Dim strWord As String strWord = InputBox("أدخل كلمة البحث") If strWord = "" Then Exit Sub Application.ScreenUpdating = False With Sheet1 Arr = .Range("B2:B" & .Cells(Rows.Count, 2).End(xlUp).Row).Value ReDim Temp(1 To UBound(Arr, 1), 1 To 1) For I = 1 To UBound(Arr, 1) If InStr(Arr(I, 1), strWord) > 0 Then Temp(I, 1) = strWord Counter = Counter + 1 End If Next I .Range("A2").Resize(UBound(Temp, 1), UBound(Temp, 2)).Value = Temp If Counter >= 1 Then .Range("A1:B1").AutoFilter With .Range("A1:B" & .Cells(Rows.Count, 1).End(xlUp).Row) .AutoFilter Field:=1, Criteria1:="<>" .Offset(1).SpecialCells(xlCellTypeVisible).Copy Sheet2.Range("A" & Sheet2.Cells(Rows.Count, 1).End(xlUp).Row + 1) .Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete End With .Range("A1:B1").AutoFilter End If End With Application.ScreenUpdating = True End Sub تقبل تحياتي Search For Specific Text Using Arrays YasserKhalil V2.rar

ارفق ملفك ليساعدك الاخوة الأعضاء .. حتى يسهل تقديم المساعدة تقبل تحياتي

حبيبي الغالي حسام يبدو إن فيه مشكلة مش عارف ايه هيا .. نفس المشكلة متحلتش !! ممكن تصور فيديو صغير إذا كان وقتك يسمح توضح فيه عمل الفورم !! استخدم برنامج Screen to EXE دا صورة للي بيحصل معايا .. الفورم التاني بيختفي من على الشاشة نهائي ..!! Watch.rar

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

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

وعليكم السلام ورحمة الله وبركاته أخي الحبيب عماد غازي بارك الله فيك وجزاك الله خيراً على هذه الموضوعات القيمة والمميزة تقبل تحياتي

اضغطي Alt+ F11 للدخول لمحرر الأكواد دا رابط ضروري الإطلاع عليه لمعرفة البدايات في التعامل مع الأكواد من هنا

الحمد لله الذي بنعمته تتم الصالحات والحمد لله أن تم المطلوب على خير أما بخصوص عاجز عن الشكر فكلا ..فقد أديت ووفيت الشكر بقولك جزاك الله خيراً ولك بمثل إن شاء الله تقبل وافر تقديري واحترامي

أخي الفاضل وائل تفضل التعديل التالي ليوافق طلبك إن شاء الله Sub Search_Using_Arrays() Dim Arr, Temp, I As Long Dim strWord As String strWord = InputBox("أدخل كلمة البحث") If strWord = "" Then Exit Sub Arr = Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row).Value ReDim Temp(1 To UBound(Arr, 1), 1 To 1) For I = 1 To UBound(Arr, 1) If InStr(Arr(I, 1), strWord) > 0 Then Temp(I, 1) = strWord End If Next I Range("A2").Resize(UBound(Temp, 1), UBound(Temp, 2)).Value = Temp End Sub تقبل تحياتي

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

بارك الله فيك أخي الحبيب عبد العزيز البسكري وجزيت خيراً موضوعاتك مميزة ومتميزة .. لا حرمنا الله منك تقبل وافر تقديري واحترامي

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

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

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

أخي الكريم أفضل كلمة "جزاكم الله خيراً" على كلمة "شكرا" ويا سيدي تعالى على نفسك شوية وزود كمان كام كلمة .. ولا وقتك ميسمحش زي حالاتي تقبل تحياتي

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

أخي الكريم حسام ما المشكلة التي تظهر لديك الآن ؟؟ هل جربت الحلول المختلفة التي قدمت لك ...؟؟!!

وعليكم السلام ورحمة الله وبركاته أخي الفاضل نبيل يرجى تغيير اسم الظهور للغة العربية ، ويرجى إرفاق ملف ليسهل على الأخوة الأعضاء تقديم المساعدة المطلوبة إن شاء الله تقبل تحياتي

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

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

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

أخي الكريم وائل شعبان حسب طلبك وملفك المرفق إليك الكود التالي (رغم أنني أعلم أن الموضوع ما زال غير مكتمل أركان التوضيح الكامل وأعلم أن هناك توابع نظراً لقصور التوضيح) .. واوعى تزعل من كلامي .. Sub Search_Using_Arrays() Dim Arr, Temp, I As Long Const strWord As String = "التجربة" Arr = Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row).Value ReDim Temp(1 To UBound(Arr, 1), 1 To 1) For I = 1 To UBound(Arr, 1) If InStr(Arr(I, 1), strWord) > 0 Then Temp(I, 1) = strWord End If Next I Range("A2").Resize(UBound(Temp, 1), UBound(Temp, 2)).Value = Temp End Sub تقبل تحياتي Search For Specific Text Using Arrays YasserKhalil.rar

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