كود حذف الصفوف بناء على قيمة محددة

[alliiia]

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

تقبل الله صالح أعمالكم

بالنسبة للعنوان أعلاه، وجدت كودًا نافعًا في تصفحي لمواقع الاكسل

وأحب أن يستفيد الجميع

دونكم الكود:

Sub DeleteRows()

Dim rng As Range
Dim InputRng As Range
Dim DeleteRng As Range
Dim DeleteStr As String
Dim xTitleId As String
Dim xArr
Dim xF As Integer
Dim xWSh As Worksheet
On Error Resume Next
xTitleId = "KutoolsforExcel"
Set rng = Application.Selection
Set InputRng = Application.InputBox("Range :", xTitleId, rng.Address, Type:=8)
If InputRng Is Nothing Then Exit Sub
DeleteStr = Application.InputBox("Delete Text", xTitleId, Type:=2)
Set xWSh = InputRng.Worksheet
For Each rng In InputRng
    If rng.Value = DeleteStr Then
        If DeleteRng Is Nothing Then
            Set DeleteRng = rng
        Else
            Set DeleteRng = Application.Union(DeleteRng, rng)
            Set DeleteRng = DeleteRng.EntireRow
        End If
    End If
Next
xArr = Split(DeleteRng.AddressLocal, ",")
DeleteRng.Select
DeleteRng.Delete
For xF = UBound(xArr) To 0 Step -1
    Set DeleteRng = xWSh.Range(xArr(xF))
    DeleteRng.Delete
Next
End Sub

 

[alliiia]

أحبتي الكرام

هل يمكن التعديل على هذا الكود؟