رسول هادي قام بنشر أبريل 12, 2020 مشاركة قام بنشر أبريل 12, 2020 السلام عليكم ارجو ان يكون الجميع بخير وصحة وعافية . بخصوص تحديد الاسماء المتكررة في ورقة العمل نفسها فهو واضح . السؤال هل بالامكان تحديد التكرار بين الاسماء في ورقتي عمل ارجو تطبيق ذلك على الملف المرفق، مع فائق الشكر والتقدير تكرار.xlsm رابط هذا التعليق شارك More sharing options...
أحمد يوسف قام بنشر أبريل 12, 2020 مشاركة قام بنشر أبريل 12, 2020 وعليكم السلام أخى الكريم .... رجاءا من الجميع الإلتزام بتعليمات وقوانين المنتدى ,فقد نبهنا مئات المرات ان لا تقوم برفع وعرض مشاركة جديدة الا بعد التأكد ان طلبك لم تم مناقشته وتداوله مسبقا داخل المنتدى فكان عليك استخدام خاصية البحث قبل انشاء هذه المشاركة -تفضل تلوين خلية بجميع اوراق العمل اذا تكررت في اي ورقة عمل وهذا موضوع ايضا اخر مختلف لعدم تكرار البيانات المدخلة فى كل صفحات الملف عدم تكرار البيانات المدخلة في كل الشيتات جزاك الله كل خير 4 رابط هذا التعليق شارك More sharing options...
أفضل إجابة سليم حاصبيا قام بنشر أبريل 12, 2020 أفضل إجابة مشاركة قام بنشر أبريل 12, 2020 جرب هذا الكود Option Explicit Sub Colorize_Dupicates() Dim Sh As Worksheet, A As Worksheet Dim Rg As Range, cel As Range, _ Act_Rg As Range, F_rg As Range Dim Fadr$, Sadr$ Dim D As Object Dim i%, X%, y% Set Sh = ActiveSheet Set Rg = Sh.Range("a1").CurrentRegion.Columns(1).Cells X = Sh.Cells(Rows.Count, 1).End(3).Row Sh.Range("C1:z" & X).Clear Set D = CreateObject("Scripting.Dictionary") Rg.Interior.ColorIndex = xlNone For Each A In Sheets A.Range("a1").CurrentRegion.Columns(1) _ .Interior.ColorIndex = xlNone A.Range("C1:z100").Clear Next For Each cel In Rg For Each A In Sheets If A.Name <> Sh.Name Then Set Act_Rg = A.Range("a1").CurrentRegion.Columns(1) X = A.Cells(Rows.Count, 1).End(3).Row Set F_rg = Act_Rg.Find(cel, lookat:=1) If F_rg Is Nothing Then GoTo Next_A cel.Interior.ColorIndex = 6 Fadr = F_rg.Address: Sadr = Fadr Do F_rg.Interior.ColorIndex = 6 D(A.Name & " :Row (" & F_rg.Row & ")") = vbNullString Set F_rg = Act_Rg.FindNext(F_rg) Sadr = F_rg.Address If Sadr = Fadr Then Exit Do Loop End If Next_A: Next A If D.Count > 0 Then With cel.Offset(, 2).Resize(, D.Count) .Value = D.keys .Borders.LineStyle = 1 .Interior.ColorIndex = 38 .InsertIndent 1 End With With cel.Offset(, 2 + D.Count) .Value = IIf(D.Count = 1, "1 Duplicate", D.Count & " Duplicates") .Borders.LineStyle = 1 .Interior.ColorIndex = 6 .InsertIndent 1 End With Else With cel.Offset(, 2) .Value = "No Duplicates" .Borders.LineStyle = 1 .Interior.Color = vbGreen .InsertIndent 1 End With End If D.RemoveAll Next cel End Sub الملف مرفق Count_Tekrars.xlsm 5 1 رابط هذا التعليق شارك More sharing options...
رسول هادي قام بنشر أبريل 12, 2020 الكاتب مشاركة قام بنشر أبريل 12, 2020 شكرا على الجهود واعتذر لعدم الالتزام بقوانين المنتدى رابط هذا التعليق شارك More sharing options...
أحمد يوسف قام بنشر أبريل 12, 2020 مشاركة قام بنشر أبريل 12, 2020 أستاذ رسول هادي أين الضغط على الإعجاب لكل هذه الإجابات ؟!!!💙 1 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان