Jump to content
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

حذف المكرر في الخلية الواحدة


Go to solution Solved by سليم حاصبيا,

Recommended Posts

الاخوة الافاضل الكرام 

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

تعودنا منكم حسن الاجابة وطيب الخلق

لدي خلية فيها اسم احمد محمد ياسين

المطلوب اولا حذف جميع الاحرف المكررة

ثانيا 

حذف المكرر والابقاء على حرف واحد من التكرار 

مثلا لو كان حرف أ مكرر ثلاث مرات 

احذف حرفين وابقي واحد

مع جزيل الشكر لكل الاخوة 

Link to post
Share on other sites

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

1-الاسماء في العامود B
2- عدد الحرف المطلوبة في العامود A
3- المعادلات في النطاق من C2  الىAF26

المعادلات  في العامود A

=IF($B2="","",SUM(IF(FREQUENCY(MATCH(MID(TRIM(SUBSTITUTE($B2," ","")),ROW(INDIRECT("1:"&LEN(TRIM(SUBSTITUTE($B2," ",""))))),1),MID(TRIM(SUBSTITUTE($B2," ","")),ROW(INDIRECT("1:"&LEN(TRIM(SUBSTITUTE($B2," ",""))))),1),0),MATCH(MID(TRIM(SUBSTITUTE($B2," ","")),ROW(INDIRECT("1:"&LEN(TRIM(SUBSTITUTE($B2," ",""))))),1),MID(TRIM(SUBSTITUTE($B2," ","")),ROW(INDIRECT("1:"&LEN(TRIM(SUBSTITUTE($B2," ",""))))),1),0)),1,0)))

في النطاق من C2  الى AF26

=IF(OR(COLUMNS($A$2:A2)>$A2,$A2=""),"",MID(SUBSTITUTE(TRIM($B2)," ",""),SMALL(IF(FREQUENCY(MATCH(MID(TRIM(SUBSTITUTE($B2," ","")),ROW(INDIRECT("1:"&LEN(TRIM(SUBSTITUTE($B2," ",""))))),1),MID(TRIM(SUBSTITUTE($B2," ","")),ROW(INDIRECT("1:"&LEN(TRIM(SUBSTITUTE($B2," ",""))))),1),0),MATCH(MID(TRIM(SUBSTITUTE($B2," ","")),ROW(INDIRECT("1:"&LEN(TRIM(SUBSTITUTE($B2," ",""))))),1),MID(TRIM(SUBSTITUTE($B2," ","")),ROW(INDIRECT("1:"&LEN(TRIM(SUBSTITUTE($B2," ",""))))),1),0)),ROW(INDIRECT("1:"&LEN(TRIM(SUBSTITUTE($B2," ","")))))),COLUMNS($A$2:A2)),1))

صورة عن الملف

Karim.png

الملف مرفق

KARIM.xlsx

  • Like 2
Link to post
Share on other sites
  • Solution

كان من المفروض تحميل ملف مع شرح المطلوب  بدقة (كما اقترح الاستاذ هاني محمد)

ولا لزوم لتضييع اكثر من ساعة من الوقت على كتابة معادلات وفي الأخير تظهر انها ليست المطلوبة

لذا كنت أريد الاعتذار عن المتابعة بهذا الملف

لكن حيث انها المرة الاولى لا بد من الاستجابة

الكود

Option Explicit

Function Salim_Letter(rg As Range)
Dim dic As Object, i
Dim ST, Mot$
 Mot = Replace(rg.Value, " ", "")
Set dic = CreateObject("Scripting.Dictionary")

 For i = 1 To Len(Mot)
   If Not dic.Exists(Mid(Mot, i, 1)) Then
    dic(Mid(Mot, i, 1)) = dic.Count
   End If
 Next i
  If dic.Count Then
    ST = Join(dic.keys, " ")
  Else
    ST = vbNullString
  End If
  Salim_Letter = ST
End Function

جرب هذا الملف

Remove_duplicate_letters.xlsm

  • Like 4
Link to post
Share on other sites

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

Link to post
Share on other sites

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

كل عام وانتم بخير 

مثال رائع وحله من استاذ رائع 

ولي طلب اذا امكن ابي نفس الملف ولكن بدون حذف الحروف المكرره مثال   طلال    ط ل ا ل  كل حرف في حقل 

ts.xlsm

  • Like 1
Link to post
Share on other sites

لايسعني الا ان اشكرك بما قالة الرسول صلى الله عليه وسلم 

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

فهي كافيه لكل معاني الشكر 

وتقبل تحياتي 

  • Like 2
Link to post
Share on other sites
Guest
This topic is now closed to further replies.
  • Recently Browsing   0 members

    No registered users viewing this page.

×
×
  • Create New...

Important Information