كيفية حذف الخلايا التى تحتوى على كلمات أو قيم معينة من منطقة محددة

[hlaswi]

سلام عليكم 

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

حيث قام الاستاذ الفاضل طارق محمود 

بعمل كود - لاكن يقوم بحذف البيانات من الورقة كاملة وليس المنطقة المحددة مسبقا.

 كما ظهرت مشكلة اللغة العربية - عند البحث عن بيانات باللغة العربية لا يتعرف عليها - فقط يتعرف على بيانات اللغة الانجليزية

هذا الكود 

 

() Sub deletX

Dim x As String, y As Long

d = WorksheetFunction.Find("a", "Tarek")

x = InputBox("What is the word you want to delete Cells contain it?")

If x <> "" Then GoTo 10

y = InputBox("What is the Value you want to delete Cells contain it?")

For Each ce In Range("A1", Cells.SpecialCells(xlLastCell))

          If ce.Value = y Then ce.ClearContents

Next ce

Exit Sub

10

For Each ce In Range("A1", Cells.SpecialCells(xlLastCell))

On Error Resume Next

If Len(ce) < Len(x) Then GoTo 20

aa = WorksheetFunction.Find(x, ce)

If aa > 0 Then ce.ClearContents

20

aa = 0

Next ce

End Sub  

 

Delete_Fixed_Cells.xls

[hegazee]

جرب هذا الكود

Sub deletX()
    Dim x As String, ce As Range
    x = InputBox("What is the word you want to delete Cells contain it?")
    If x = "" Then Exit Sub
    For Each ce In Selection
        On Error Resume Next
        If Len(ce.Value) >= Len(x) And InStr(1, ce.Value, x, vbTextCompare) > 0 Then ce.ClearContents
        On Error GoTo 0
    Next ce
End Sub

 

[محمد هشام.]

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

جرب هدا 

Sub deletX()
    Dim x As String, wordn As Long
    Dim ce As Range, rng As Range, n As Boolean

     'نطاق ثابت
'    Set rng = Range("C4:R15") ' قم بتعديله بما يناسبك

    ' تحديد النطاق يدويًا
    On Error Resume Next
   Set rng = Application.InputBox("Select the range you want to search:", Type:=8)
    On Error GoTo 0
    
    If rng Is Nothing Then Exit Sub

    Do
        x = InputBox("What is the word whose cells you want to delete?")
        If x = "" Then
            If MsgBox("The input box is empty. Do you want to try again?", _
            vbYesNo + vbExclamation, "Empty Input") = vbNo Then Exit Sub
        End If
    Loop While x = ""

    If MsgBox("Are you sure you want to delete cells containing the word: " & x & _
                  "?", vbYesNo + vbQuestion, "Confirm Deletion") = vbNo Then Exit Sub

    n = False

    For Each ce In rng
        If Not IsEmpty(ce.Value) And Len(ce.Value) >= Len(x) Then
            wordn = InStr(1, LCase(ce.Value), LCase(x))
            If wordn > 0 Then
                ce.ClearContents
                n = True
            End If
        End If
    Next ce

    If n Then
        MsgBox "تم الحذف بنجاح", vbInformation
    Else
        MsgBox "لم يتم العثور على الكلمة: " & x, vbExclamation
    End If
End Sub

 

Delete_Fixed_Cells.xls