aburajai قام بنشر سبتمبر 14, 2023 مشاركة قام بنشر سبتمبر 14, 2023 السلام عليكم كيف الحال ايها الاعواء صديق قديم يطلب المساعدة في تصفية كلمة من فقرة في خلية مع تصدير النتائج فقط الى شيت جديد باسم الكلمة انظر الملف المرفق مع الشكر الجزيل لكم وبارك الله فيكم اوفسينا.xls رابط هذا التعليق شارك More sharing options...
محي الدين ابو البشر قام بنشر سبتمبر 14, 2023 مشاركة قام بنشر سبتمبر 14, 2023 عليكم السلام ربما Sub test() Dim a Dim i&, c& a = Sheets("sheet1").Cells(5, 1).CurrentRegion.Columns(1) With CreateObject("VBScript.RegExp") .Global = True .Pattern = "جميلة" For i = 1 To UBound(a) If .test(a(i, 1)) Then Sheets("جميلة").Cells(c + 1, 1) = a(i, 1) c = c + 1 End If Next End With End Sub 2 رابط هذا التعليق شارك More sharing options...
أ / محمد صالح قام بنشر سبتمبر 14, 2023 مشاركة قام بنشر سبتمبر 14, 2023 يمكنك تجربة هذه المحاولة بالمعادلات بدلا من تصدير النتائج في شيت جديد يمكنك كتابة مصطلح البحث والحصول على النتائج في شيت النتائج أهم شيء معادلة المسلسل في شيت البيانات data لأن معادلة البحث vlookup تعتمد عليها بالتوفيق فلترة نتائج البحث في شيت جديد.xls 3 1 رابط هذا التعليق شارك More sharing options...
محي الدين ابو البشر قام بنشر سبتمبر 14, 2023 مشاركة قام بنشر سبتمبر 14, 2023 حل آخر Sub test2() Dim a Dim i&, c& a = Sheets("sheet1").Cells(5, 1).Resize(Sheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row - 4) For i = 1 To UBound(a) If a(i, 1) <> "" Then If IsNumeric(Application.Match("جميلة", Split(a(i, 1)), 0)) Then Sheets("جميلة").Cells(c + 1, 1) = a(i, 1) c = c + 1 End If: End If Next End Sub 3 رابط هذا التعليق شارك More sharing options...
aburajai قام بنشر سبتمبر 14, 2023 الكاتب مشاركة قام بنشر سبتمبر 14, 2023 اخي وضعته كماكرو في الملف لكن لم يعمل ؟ هل تذكرني بالطريقة الصحيحة لوضعه اشكرك الاستاذ محمد صالح لو سمحت ممكن تضيف اللون لكلمة البحث في شيت البحث لو تكرمت تلون كلمة البحث في شيت البحث ثم ليبدأ قبل 10 كلمات من كلمة البحث واضافة 10 كلمات بعدها فقط لان احيانا الفقرة تكون كبيرة فاريد يبدا من 10 كلمات قبلها و 10 كلمات بعدها بارك الله فيك رابط هذا التعليق شارك More sharing options...
محي الدين ابو البشر قام بنشر سبتمبر 14, 2023 مشاركة قام بنشر سبتمبر 14, 2023 تفضل اوفسينا.xlsm 2 رابط هذا التعليق شارك More sharing options...
aburajai قام بنشر سبتمبر 14, 2023 الكاتب مشاركة قام بنشر سبتمبر 14, 2023 لا اعرف السبب في ذلك فقد فتحته فلم اجد انه تم الترحيل الى شيت جميل انظر الصورة ؟ رابط هذا التعليق شارك More sharing options...
محي الدين ابو البشر قام بنشر سبتمبر 15, 2023 مشاركة قام بنشر سبتمبر 15, 2023 لا أدري ما المشكلة عندك على كل اتبع ما هو هو مكتوب في المرفق اوفسينا.xlsm 3 رابط هذا التعليق شارك More sharing options...
aburajai قام بنشر سبتمبر 21, 2023 الكاتب مشاركة قام بنشر سبتمبر 21, 2023 بارك الله فيكم استاذ ابو اليسر لو سمحت تعملع امتداد xls مش عارف افتحه على امتداد xlsm شكرا لك رابط هذا التعليق شارك More sharing options...
محي الدين ابو البشر قام بنشر سبتمبر 21, 2023 مشاركة قام بنشر سبتمبر 21, 2023 xlsاوفسينا.xls 1 رابط هذا التعليق شارك More sharing options...
aburajai قام بنشر سبتمبر 21, 2023 الكاتب مشاركة قام بنشر سبتمبر 21, 2023 (معدل) استاذ محي الدين ابو البشر شكرا لك الان نمام لو تكرمت فيما لو كانت الفقرة طويلة فاريد ان تعمل جلب كلمة "جميلة" وقبلها 10 كلمات وبعدها 10 كلمات شكرا لكم تم تعديل سبتمبر 21, 2023 بواسطه aburajai رابط هذا التعليق شارك More sharing options...
محي الدين ابو البشر قام بنشر سبتمبر 24, 2023 مشاركة قام بنشر سبتمبر 24, 2023 السلام عليكم عذراً أخي الكريم على التأخير في الرد استبدل test2 بـ الكود Sub test2() Dim a, y Dim i&, c&, x& Application.ScreenUpdating = False Sheets("جميلة").Columns(1).ClearContents a = Sheets("sheet1").Cells(5, 1).Resize(Sheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row - 4) For i = 1 To UBound(a) If a(i, 1) <> "" Then y = Split(a(i, 1)) If IsNumeric(Application.Match("جميلة", Split(a(i, 1)), 0)) Then x = Application.Match("جميلة", Split(a(i, 1)), 0) If UBound(y) > 21 Then y = Application.Transpose(Application.Index(y, Evaluate("row(" & x - 10 & ":" & x + 10 & ")"))) Sheets("جميلة").Cells(c + 1, 1) = Join(y) Else Sheets("جميلة").Cells(c + 1, 1) = a(i, 1) End If c = c + 1 End If: End If Next Sheets("جميلة").Activate Application.ScreenUpdating = True End Sub رابط هذا التعليق شارك More sharing options...
aburajai قام بنشر سبتمبر 25, 2023 الكاتب مشاركة قام بنشر سبتمبر 25, 2023 (معدل) في 24/9/2023 at 12:53, محي الدين ابو البشر said: Sub test2() Dim a, y Dim i&, c&, x& Application.ScreenUpdating = False Sheets("جميلة").Columns(1).ClearContents a = Sheets("sheet1").Cells(5, 1).Resize(Sheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row - 4) For i = 1 To UBound(a) If a(i, 1) <> "" Then y = Split(a(i, 1)) If IsNumeric(Application.Match("جميلة", Split(a(i, 1)), 0)) Then x = Application.Match("جميلة", Split(a(i, 1)), 0) If UBound(y) > 21 Then y = Application.Transpose(Application.Index(y, Evaluate("row(" & x - 10 & ":" & x + 10 & ")"))) Sheets("جميلة").Cells(c + 1, 1) = Join(y) Else Sheets("جميلة").Cells(c + 1, 1) = a(i, 1) End If c = c + 1 End If: End If Next Sheets("جميلة").Activate Application.ScreenUpdating = True End Sub السلام عليكم وضعته ماكرو جديد لكن عمل ديبج على هذا السطر كما في الصورة لا تنسى استاذ ان الملف امتداد XLS تم تعديل سبتمبر 25, 2023 بواسطه aburajai رابط هذا التعليق شارك More sharing options...
محي الدين ابو البشر قام بنشر سبتمبر 26, 2023 مشاركة قام بنشر سبتمبر 26, 2023 xlsاوفسينا.xls رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان