حذف الصفوف بطريقة مخصصة Delete Rows In Specific Way

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

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

بفرض أن لديك ورقة عمل باسم Data وبها الخلية G7 تحتوي على رقم ، هذا الرقم هو عدد الصفوف المراد حذفها.

ولديك ورقة عمل أخرى باسم Sheet1 وتريد حذف الصفوف بدايةً من الصف العاشر وبامتداد خمسة صفوف كما هو مقرر من الخلية G7 في ورقة العمل Data ، أي أنك تريد حذف الصفوف من الصف 10 إلى الصف 14 ( 10 - 11 - 12 - 13 - 14)

الكود مكون من جزء رئيسي وجزء فرعي ، الجزء الرئيسي يشبه الدوال المعرفة وهو عبارة عن إجراء مخصص ، أي له بارامترات يعتمد عليها كما في الدوال المعرفة UDF ، والبارامترات في الإجراء المخصص بالشكل التالي :

البارامتر الأول هو اسم ورقة العمل ويوضع بين أقواس تنصيص .. فكما في المثال اسم ورقة العمل المطلوب حذف الصفوف منها هو Sheet1.

والبارامتر الثاني هو صف البداية المطلوب بداية الحذف منه ، وهو هنا في المثال المرفق رقم 10 ، حيث يمثل أول صف تريد الحذف على أساسه.

لاستخدام هذا الإجراء المخصص ، تقوم بإنشاء إجراء فرعي وتكتب فيه اسم الإجراء المخصص وقد أسميته DeleteRow ، يليه اسم ورقة العمل "Sheet1" بين أقواس تنصيص ثم رقم صف البداية وهو الرقم 10

وأخيراً إليكم الكود المستخدم ، ويوضع الكود في موديول عادي :

Sub TestRun()
    DeleteRow "Sheet1", 10
End Sub

Sub DeleteRow(sSheet As String, sRow As Long)
    Dim Ws As Worksheet
    Dim cnt As Long

    On Error Resume Next
        Set Ws = Sheets(sSheet)
    On Error GoTo 0

    If Ws Is Nothing Then
        MsgBox "Sheet " & sSheet & "  Doesn't Exist.", vbExclamation, "Sheet Not Found!"
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
        cnt = Sheets("Data").Range("G7").Value
        Ws.Rows(sRow & ":" & (sRow + cnt - 1)).Delete
    Application.ScreenUpdating = True
End Sub

تحميل الملف من هنا

إعداد / ياسر خليل أبو البراء