كيفية إزالة الكلمات و الأحرف المتكررة في خلية إكسيل Excel

 كيفية إزالة الكلمات المتكررة في خلية Excel

كود كلش حلو وجميل يحذف الكلمات المتكرره ثم يضعها في عامود منفصل

لإزالة النص المكرر في خلية ، يمكنك استخدام الوظيفة التالية المعرفة من قبل المستخدم (UDF) ، المسماة RemoveDupeWords وذلك عن طريق كود نضعه في الماكور VBS كالتالي : 

 ـ Alt + F11 لفتح محرر Visual Basic

في الجزء الأيمن ، انقر بزر الماوس الأيمن فوق ThisWorkbook وحدد إدراج > مديول 

الصق الكود المرفق ادناه في نافذة الكود

بعدها نكتب الداله في الخليه 

اذا كانت البيانات المكرره مفصوله بفاصله , نستخدم صيغه تالية : 

RemoveDupeWords(A2; ",")=

اي بين علامتين اقتباس نضع نوع فاصله " " 

واذا كانت البيانات المكرره مفصوله بمسافه نستخدم

الصيغه التاليه : 

RemoveDupeWords(A2)=

صوره توضح مثال يوضح حذف الكلمات المتكررة اذا كانت مفصوله بفاصله 

صورة توضح مثال يوضح حذف الكلمات المتكررة اذا كانت مفصوله بمسافه

الكود المستخدم بالشرح

Function RemoveDupeWords(text As String, Optional delimiter As String = " ") As String
    Dim dictionary As Object
    Dim x, part
 
    Set dictionary = CreateObject("Scripting.Dictionary")
    dictionary.CompareMode = vbTextCompare
    For Each x In Split(text, delimiter)
        part = Trim(x)
        If part <> "" And Not dictionary.Exists(part) Then
            dictionary.Add part, Nothing
        End If
    Next
 
    If dictionary.Count > 0 Then
        RemoveDupeWords = Join(dictionary.keys, delimiter)
    Else
        RemoveDupeWords = ""
    End If
 
    Set dictionary = Nothing
End Function

كود ايضا جميل 

أزالة الاحرف المتكرره في الكلمه في الإكسيل

لإزالة الاحرف المتكرره في الكلمه  ، يمكنك استخدام الوظيفة التالية 

RemoveDupeChars(A2)=

ملاحظه يتعامل هذا كود مع الارقام والنصوص اي يقوم بحذف الارقام والنصوص المتكررة 

 صوره توضيح المثال 

الكود المستخدم

Function RemoveDupeChars(text As String) As String
    Dim dictionary As Object
    Dim char As String
    Dim result As String
 
    Set dictionary = CreateObject("Scripting.Dictionary")
 
    For i = 1 To Len(text)
        char = Mid(text, i, 1)
        If Not dictionary.Exists(char) Then
            dictionary.Add char, Nothing
            result = result & char
        End If
    Next
 
    RemoveDupeChars = result
    Set dictionary = Nothing
End Functio

تعديل المقال