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

[gadelrab]

الاخوة الاعزاء السلام عليكم ورحمة الله

لدى جدول احصائى به مجموعة من القيم

واريد استخراج عمود به الخلايا المكررة

وعمود اخر به عدد مرات التكرار حتى ولو كان مرة واحدة

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

ارجو المساعدة فى ايجاد المطلوب

وجزاتكم الله خير الجزاء

التكرار.rar

[هشام شلبى]

السلام عليكم

===========

تفضل المرفق

التكرار.rar

[يحيى حسين]

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

أخي حسب طلبك

تريد اولأ : استخراج قائمة بالأرقام بدون تكرار من جدولك, و لعمل ذلك سنقوم أولاً بتحويل الجدول الى عامود بالمعادلة التالية : ضعها في الخلية Ua

=INDEX($A$1:$R$9,INT((ROWS($U$2:U2)-1)/COLUMNS($A$1:$R$1))+1,MOD(ROWS($U$2:U2)-1,COLUMNS($A$1:$R$1))+1)

ثم في اخلية X2 ضع المعادلة التالية و هي معادلة صفيف , و ذلك لإستخراج القيم بدون تكرار

 =INDEX(U:U,MIN(IF(COUNTIF($X$1:X1,$U$2:$U$163),2^16,ROW($U$2:$U$163)))) 

و أخيراً في الخلية y2 ضع المعادلة التالية

 =COUNTIF($A$1:$R$9,X2) 

يحيى حسين - التكرار.rar

[قصي]

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

[gadelrab]

الاستاذ العزيز هشام شلبى

شكراً جزيلاً لك لقد تفضلت بايجاد عدد التكرات ولكن المطلوب ايضاً قيمة التكرارات

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

الاستاذ العزيز يحيى حسين

ما تفضلت به هو المطلوب

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

[يحيى حسين]

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

أخي جاد الرب

هذا كود يقوم بعمل كل الخطوات السابقة و هو أسهل و أسرع

 


Sub Excel4us()

Dim i As Integer, y As Integer, x As Integer

Application.ScreenUpdating = False

x = 1

For y = 1 To 18

	For i = 1 To 9

    	Range("u" & x).Value = Cells(i, y).Value

    	x = x + 1

	Next i

Next y


With Range("u1:u" & Range("u" & Rows.Count).End(xlUp).Row)

	.SpecialCells(xlCellTypeBlanks).Delete shift:=xlUp

End With

With Range("u1:u" & Range("u" & Rows.Count).End(xlUp).Row)

	.AdvancedFilter xlFilterCopy, , [v1], True

End With

For Each c In Range("w1:W" & Range("v" & Rows.Count).End(xlUp).Row)

	c.Value = WorksheetFunction.CountIf(Range("u1:u" & Range("u" & Rows.Count).End(xlUp).Row), c.Offset(, -1).Value)

Next c

Columns("u").Delete

Application.ScreenUpdating = True

End Sub

[ياسر خليل أبو البراء]

السلام عليكم

إثراءاً للموضوع هذا حل آخر مأخوذ من أحد المنتديات الأجنبية

إليكم الملف المرفق

أخوكم أبو البراء

DistinctValuesWithinRange.rar

[أبو محمد عباس]

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

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

وظهرت لي مشكلة وهي وجود فراغات عند التصفية في الكود او في المعادلات فهل يمكن تلافي الخلايا الفارغة عند طلب الاسماء بدون تكرار

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

 

تصفية جدول بدون تكرار البيانات.rar