mmm83 قام بنشر سبتمبر 2, 2021 مشاركة قام بنشر سبتمبر 2, 2021 السلام عليكم لطفا اساتذة المطلوب كود لاستخراج الحروف المكررة وغير المكررة من النص بارك الله فيكم وكما في الملف المرفق الاحرف المكررة وغير المكررة.xlsx 1 رابط هذا التعليق شارك More sharing options...
أفضل إجابة أ / محمد صالح قام بنشر سبتمبر 2, 2021 أفضل إجابة مشاركة قام بنشر سبتمبر 2, 2021 يمكنك استعمال هذا الكود بعد فك دمج الخلايا وتغيير الامتداد إلى xlsb حتى يقبل الأكواد Sub repchr() Range("b6,b9").ClearContents For n = 1 To Len([b3]) If UBound(Split([b3], Mid([b3], n, 1))) > 1 Then [b6] = [b6] & IIf(InStr([b6], Mid([b3], n, 1)) = 0 And Mid([b3], n, 1) <> " ", IIf([b6] = "", "", "-") & Mid([b3], n, 1), "") Else [b9] = [b9] & IIf([b9] = "", "", "-") & Mid([b3], n, 1) End If Next n MsgBox "Done by mr-mas.com" End Sub الكود يقوم بوضع الحروف المكررة في الخلية b6 والحروف غير المكررة في الخلية b9 اعتمادا على النص الموجود في الخلية b3 بالتوفيق 5 رابط هذا التعليق شارك More sharing options...
lionheart قام بنشر سبتمبر 2, 2021 مشاركة قام بنشر سبتمبر 2, 2021 Sub Test() [B6] = GetDupUniq([B3], True) [B9] = GetDupUniq([B3], False) End Sub Function GetDupUniq(ByVal txt As String, ByVal f As Boolean) As String Dim e, s As String, i As Long With CreateObject("Scripting.Dictionary") .CompareMode = 1 For i = 1 To Len(txt) s = Mid$(txt, i, 1) If s <> " " Then .Item(s) = .Item(s) + 1 Next i For Each e In .Keys If (f = True And .Item(e) = 1) Or (f = False And .Item(e) > 1) Then .Remove e Next e GetDupUniq = Join(.Keys, "-") End With End Function 1 رابط هذا التعليق شارك More sharing options...
mmm83 قام بنشر سبتمبر 2, 2021 الكاتب مشاركة قام بنشر سبتمبر 2, 2021 شكرا جزيلا لكم استاذ على المساعدة ولجميع الاخوة نسال الله تعالى ان يحفظكم اجمعين 1 رابط هذا التعليق شارك More sharing options...
mmm83 قام بنشر سبتمبر 3, 2021 الكاتب مشاركة قام بنشر سبتمبر 3, 2021 وللافاده وجدت هذا الكود الرائع للاستاذ سليم لحذف المكرر من الحروف 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 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.