حذف (صفوف فارغة - نص مكرر - بناء ع قيمة خلية) مرفق مثال توضيحى

[عاشق الاكسيل]

السلام عليكم ورحمة الله وبركاته

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

1- حذف الصفوف الفارغة

بين كل صف وصف هناك صف فارغ لا حاجة اليه

2- حذف نص متكرر

بين كل بيانات لحساب رئيسى يتم تكرار العنوان مرة اخرة

3- حذف الاجمالى الفرعى لكل حساب منفصل مع الابقاء على اجمالى الكل

دمتم عونا لنا باذن الله

Book1.rar

[عاشق الاكسيل]

فى انتظار مساعدتكم اخوتى الاعزاء

[الـعيدروس]

السلام عليكم

تفضل

Sub Ali_Rows()
Dim Rng As Range, Rng_a As Range
Dim Lr&
With ActiveSheet
Application.ScreenUpdating = False
Application.EnableEvents = True
Lr = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
For Each Rng In Range(Cells(5, 1), Cells(Lr, 1))
  If Rng = Empty Or Trim(.Cells(Rng.Row, 15)) = "الاجمالى" _
   Or Trim(CStr(Rng)) = "دائن" Then
   If Not Rng Is Nothing Then If Rng_a Is Nothing Then _
   Set Rng_a = Rng Else Set Rng_a = Union(Rng_a, Rng)
  End If
Next
If Not Rng_a Is Nothing Then
Application.DisplayAlerts = False
''************************
    Rng_a.EntireRow.Delete
''************************
Application.DisplayAlerts = True
End If
Set Rng = Nothing:Set  Rng_a = Nothing
Application.ScreenUpdating = True
Application.EnableEvents = False
End With
End Sub

 

تم تعديل نوفمبر 20, 2015 بواسطه الـعيدروس

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

أخي ومعلمي أبو نصار

كود رائع جداً وسريع للغاية حيث أنه يقوم بعمل تجميع للنطاقات التي ينطبق عليها الشروط

ملحوظة صغيرة ...في هذا السطر

Rng_a = Nothing

نضع في البداية كلمة Set

 

[الـعيدروس]

السلام عليكم

اشكرك اخي الحبيب ياسر خليل

على مرورك العطر 

صحيح الملاحظه التي ذكرتها سقط سهواً

تقبل تحياتي وشكري

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

تم تعديل نوفمبر 20, 2015 بواسطه الـعيدروس

[saad abed]

استاذى ابونصار

ما اروع اكوادك ومساعداتك وجودك بيننا مكسب كبير

اسال الله ان يديم عليك الصحة والعافيه

جزاك الله خيرا

 

استاذى ابونصار

ما اروع اكوادك ومساعداتك وجودك بيننا مكسب كبير

اسال الله ان يديم عليك الصحة والعافيه

جزاك الله خيرا

 

[الـعيدروس]

الاخ الحبيب سعد عابد

تسلم على مرورك الكريم وكلماتك الطيبه المشجعه

تقبل تحياتي وشكري 

[سليم حاصبيا]

بعد أذن اخي و صديقي العيدروس

و اثراء للموضوغ

هذا الكود

Sub Salim_Rows()
    
    Dim Lr&, lr2&
With ActiveSheet
Application.ScreenUpdating = False

Lr = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
    Range("a5:a" & Lr).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Range("a5:a" & Lr).SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
 lr2 = Cells(Rows.Count, "o").End(3).Row
    Range("o5:o" & lr2 - 1).SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
Application.ScreenUpdating = True

End With
End Sub

 

تم تعديل نوفمبر 20, 2015 بواسطه سليم حاصبيا

[عاشق الاكسيل]

طالما كان هذا هو المنتظر والمتوقع
 من اساتذتى

شكرا استاذى العيدروس

شكرا استاذى سليم حاصيبا

اما عن استاذى ياسر خليل ابو البراء

فلك منى كل تحية احترام وتقدير كم اشتقت الى مشاركاتك ومساعدتك الدائمة لى وللجميع