أكاديمية الصقر للتدريب

اعلن هنا
أكاديمية الصقر للتدريب
أعلن هنا
أعلن هنا
صفحتنا على الفيس بوك
أعلن هنا

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز
المشرف المتميز
المراقب المتميز
المدير المتميز
الموضوع المتميز
القسم المتميز
khaled alborene Eslam Abdullah لا تميز خلال هذه الفترة YasserKhalil برنامج مرتبات الصقر - الاصدار التانى - حسام خطاب اكسيل اسئله واجابات




أهلا وسهلا بك زائرنا الكريم في أكاديمية الصقر للتدريب، لكي تتمكن من المشاركة ومشاهدة جميع أقسام المنتدى وكافة الميزات ، يجب عليك إنشاء حساب جديد بالتسجيل بالضغط هنا أو تسجيل الدخول اضغط هنا إذا كنت عضواً .





استخراج القيم المكررة فقط

السلام عليكم ورحمة الله وبركاته أهلا ومرحبا بكم أخوانى الكرام موضوع اليوم هو تقديم حل لاحدى المشكلات قد قدم الكثير حلول ..



10-10-2018 12:09 صباحا
Eslam Abdullah
menu_open
مشرف على لغات برمجة آخرى
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 03-10-2017
رقم العضوية : 852
المشاركات : 1286
الجنس : ذكر
تاريخ الميلاد : 1-9-1995
الدعوات : 3
يتابعهم : 3
يتابعونه : 63
قوة السمعة : 7778
الاعجاب : 2215
 offline 

السلام عليكم ورحمة الله وبركاته
أهلا ومرحبا بكم أخوانى الكرام موضوع اليوم هو تقديم حل لاحدى المشكلات


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

Mjk1Njk1MQ3030005
كما موضح بالصورة الحل ب3 طرق واحدة باستخدام معادلات الصفيف وأخرى بإستخدام دالة معرفة وأخرى بإستخدام كود VBA
جميع الحلول تأخذ القيم التى تم تكرارها فقط ونقل قيمة واحدة لكل منهم فى عمود أخر ويتم تجاهل الخلايا الفارغة
معادلة الصفيف فى الخلية B2 كالتالى

=IFERROR(INDEX($A$2:$A$11,SMALL(IF(FREQUENCY(IF($A$2:$A$11<>"",MATCH($A$2:$A$11,$A$2:$A$11,0),""),MATCH($A$2:$A$11&"",$A$2:$A$11&"",0))>1,ROW($A$2:$A$11)-ROW($A$2)+1,""),ROWS($C$2:C2))),"")

بعد كتابة المعادلة نضغط على Ctrl+Shift+Enter لانها معادلة صفيف

كود الدالة المعرفة AlsaqrDuplicate كالتالى
Function AlsaqrDuplicate(rng As Range, rw As Long)
'Programming by Eslam Abdullah
Dim Content As New Collection, i&
On Error Resume Next
     For i = 1 To rng.Find("*", , , , , 2).Row
        If rng.Cells(i).Value <> "" And Application.CountIf(rng, rng.Cells(i)) > 1 Then _
           Content.Add rng.Cells(i), CStr(rng.Cells(i))
        If Content.Count = rw Then AlsaqrDuplicate = Content.Item(rw): Exit Function
     Next i
     AlsaqrDuplicate = ""
End Function

استخدام الدالة بسيط جدا تتكون من 2 باراميتر الأول هو النطاق والثانى هو رقم تسلسل القيمة المستخرجة
كود الVBA كالتالى
Sub Duplicate()
'Programming by Eslam Abdullah
Dim dic As Object, lr&, i&
Cells(2, 4).Resize(Rows.Count - 1).ClearContents
    Set dic = CreateObject("Scripting.Dictionary"): dic.CompareMode = 1
    lr = Cells(Rows.Count, 1).End(3).Row
        For i = 2 To lr
            If Not dic.Exists(Cells(i, 1).Value) And Cells(i, 1).Value <> "" And Application.CountIf(Range("A2:A" & lr), Cells(i, 1)) > 1 Then _
            dic(Cells(i, 1).Value) = Cells(i, 1).Value
        Next i
    Cells(2, 4).Resize(dic.Count).Value = Application.Transpose(dic.Items)
End Sub


المثال قدامك فى الصوره والمعادلات والاكواد قدامك انقلها وبكدا انت فى غنى عن تحميل اى ملف
وللدعم البسيط تحميل ملف العمل لرؤية الروابط والمرفقات عليك الرد على الموضوع

كان معكم ومعنا ومعاهم برضوا أخاكم فى الله اسلام عبدالله
دمتم فى حفظ الله ورعايته 81




لرؤية الروابط والمرفقات عليك الرد على الموضوع


أثارت هذه المشاركة إعجاب: السعيد الجزائري، YasserKhalil، الصقر، ali mohamed ali، مهند محسن، salim،





10-10-2018 06:45 صباحا
مشاهدة مشاركة منفردة [1]
YasserKhalil
menu_open عضوية موثقة
مراقب عام
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 5039
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 14
يتابعهم : 0
يتابعونه : 331
قوة السمعة : 14698
الاعجاب : 5483
 offline 
look/images/icons/i1.gif استخراج القيم المكررة فقط
بارك الله فيك أخي الحبيب إسلام وجزاك الله كل خير ، وجعل ما تقدمه يكون لك شفيعاً إنك تاخد اعفا من الجيش

أثارت هذه المشاركة إعجاب: Eslam Abdullah،




10-10-2018 06:56 صباحا
مشاهدة مشاركة منفردة [2]
الصقر
menu_open عضوية موثقة
مدير المنتدى
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 2
المشاركات : 1487
الجنس : ذكر
الدعوات : 13
يتابعهم : 0
يتابعونه : 402
قوة السمعة : 12692
الاعجاب : 3107
موقعي : زيارة موقعي
 offline 
look/images/icons/i1.gif استخراج القيم المكررة فقط

جزاكم الله خيرا يا غالى 3



أثارت هذه المشاركة إعجاب: YasserKhalil، Eslam Abdullah،


توقيع :الصقر

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



10-10-2018 07:26 صباحا
مشاهدة مشاركة منفردة [3]
khaled alborene
menu_open
عضو ماسي
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 16
المشاركات : 554
الجنس : ذكر
تاريخ الميلاد : 9-9-1990
الدعوات : 1
يتابعهم : 7
يتابعونه : 6
قوة السمعة : 619
الاعجاب : 246
 offline 
look/images/icons/i1.gif استخراج القيم المكررة فقط
سلمت يمناك

أثارت هذه المشاركة إعجاب: Eslam Abdullah،




10-10-2018 09:03 صباحا
مشاهدة مشاركة منفردة [4]
Eslam Abdullah
menu_open
مشرف على لغات برمجة آخرى
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 03-10-2017
رقم العضوية : 852
المشاركات : 1286
الجنس : ذكر
تاريخ الميلاد : 1-9-1995
الدعوات : 3
يتابعهم : 3
يتابعونه : 63
قوة السمعة : 7778
الاعجاب : 2215
 offline 
look/images/icons/i1.gif استخراج القيم المكررة فقط
مشكور مروركم الغالى أساتذتى الأحباء ياسر وحسام
ومشكور مروركم الكريم أستاذ خالد
وربنا يسمع منك وأخد اعفا biggrin2

أثارت هذه المشاركة إعجاب: الصقر، YasserKhalil،




10-10-2018 09:54 صباحا
مشاهدة مشاركة منفردة [5]
ali mohamed ali
menu_open
عضو محترف
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 20-11-2017
رقم العضوية : 1757
المشاركات : 643
الدولة : مصر
الجنس : ذكر
يتابعهم : 0
يتابعونه : 28
قوة السمعة : 3186
الاعجاب : 1022
 offline 
look/images/icons/i1.gif استخراج القيم المكررة فقط
بارك الله فيك استاذ اسلام موضوع قيم ومطلوب دائما جعله الله فى ميزان حسناتك
وأتمنى من الله الكريم اذا كان هذا طلبك ورغبتك فى الإعفا ان يعطيك ويمن الله الكريم العزيز عليك بكل ما ترغب وتحب ان شاء الله

أثارت هذه المشاركة إعجاب: Eslam Abdullah، YasserKhalil،


توقيع :ali mohamed ali
{ وَقُل رَّبِّ زِدْنِي عِلْمًا }
[ كن على يقين من اعمالنا نخطئ ومن اخطائنا نتعلم ولذلك لا شي مستحيل ]
ساهم دائماً فى حل أى مشكلة او أستفسار لديك مع إضافة رد بشكره
أو دعوة لمن قدم اليك المساعدة,فالجميع هنا يعمل على مساعدة
 الاخرين لوجه الله وان تحتسب له اجر عند الله


10-10-2018 11:27 صباحا
مشاهدة مشاركة منفردة [6]
Eslam Abdullah
menu_open
مشرف على لغات برمجة آخرى
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 03-10-2017
رقم العضوية : 852
المشاركات : 1286
الجنس : ذكر
تاريخ الميلاد : 1-9-1995
الدعوات : 3
يتابعهم : 3
يتابعونه : 63
قوة السمعة : 7778
الاعجاب : 2215
 offline 
look/images/icons/i1.gif استخراج القيم المكررة فقط
مشكور مرورك العطر ودعائك الطيب أستاذ على 81

أثارت هذه المشاركة إعجاب: ali mohamed ali،




10-10-2018 11:46 صباحا
مشاهدة مشاركة منفردة [7]
مهند محسن
menu_open
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-03-2018
رقم العضوية : 5025
المشاركات : 177
الجنس : ذكر
تاريخ الميلاد : 19-3-1990
يتابعهم : 0
يتابعونه : 5
قوة السمعة : 303
الاعجاب : 132
 offline 
look/images/icons/i1.gif استخراج القيم المكررة فقط
أحسنت استاذ اسلام بارك الله فيك

أثارت هذه المشاركة إعجاب: Eslam Abdullah،




10-10-2018 02:59 مساء
مشاهدة مشاركة منفردة [8]
Eslam Abdullah
menu_open
مشرف على لغات برمجة آخرى
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 03-10-2017
رقم العضوية : 852
المشاركات : 1286
الجنس : ذكر
تاريخ الميلاد : 1-9-1995
الدعوات : 3
يتابعهم : 3
يتابعونه : 63
قوة السمعة : 7778
الاعجاب : 2215
 offline 
look/images/icons/i1.gif استخراج القيم المكررة فقط
مشكور مرورك العطر على الموضوع المتواضع أستاذ مهند 81

أثارت هذه المشاركة إعجاب: مهند محسن،




10-10-2018 06:18 مساء
مشاهدة مشاركة منفردة [9]
salim
menu_open
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 235
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
يتابعهم : 13
يتابعونه : 8
قوة السمعة : 2347
الاعجاب : 528
 offline 
look/images/icons/i1.gif استخراج القيم المكررة فقط
بارك الله بك اخي حسام
و زيادة في اثؤاء الموضوع  هذا الكود

Option Explicit
Sub Extarct_dup()
Dim r%, m%: m = 4
Dim x%, Y%, k%
Range("d1").CurrentRegion.Offset(1, 0).Columns(1).ClearContents
r = Range("a1").CurrentRegion.Columns(1).Rows.Count
k = 2
Do Until k > r
    x = Application.CountIf(Cells(2, 1).Resize(r, 1), Cells(k, 1))
    Y = Application.CountIf(Cells(2, 4).Resize(k - 1, 1), Cells(k, 1))
       If x > 1 And Y = 0 Then
         Cells(m - 2, 4) = Cells(k, 1)
         m = m + 1
       End If
       k = k + 1
Loop
End Sub


أثارت هذه المشاركة إعجاب: Eslam Abdullah، YasserKhalil،




10-10-2018 08:53 مساء
مشاهدة مشاركة منفردة [10]
Eslam Abdullah
menu_open
مشرف على لغات برمجة آخرى
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 03-10-2017
رقم العضوية : 852
المشاركات : 1286
الجنس : ذكر
تاريخ الميلاد : 1-9-1995
الدعوات : 3
يتابعهم : 3
يتابعونه : 63
قوة السمعة : 7778
الاعجاب : 2215
 offline 
look/images/icons/i1.gif استخراج القيم المكررة فقط
المشاركة الأصلية كتبت بواسطة: salim »
بارك الله بك اخي حسام
و زيادة في اثؤاء الموضوع  هذا الكود

Option Explicit
Sub Extarct_dup()
Dim r%, m%: m = 4
Dim x%, Y%, k%
Range("d1").CurrentRegion.Offset(1, 0).Columns(1).ClearContents
r = Range("a1").CurrentRegion.Columns(1).Rows.Count
k = 2
Do Until k > r
    x = Application.CountIf(Cells(2, 1).Resize(r, 1), Cells(k, 1))
    Y = Application.CountIf(Cells(2, 4).Resize(k - 1, 1), Cells(k, 1))
       If x > 1 And Y = 0 Then
         Cells(m - 2, 4) = Cells(k, 1)
         m = m + 1
       End If
       k = k + 1
Loop
End Sub


انا اسلام استاذ سليم ركز biggrin2
ومشكور مرورك العطر ومشكور اثرائك للموضوع
ونصيحه حاول تبعد عن المنطق دا أغالى فى الكود
لانه مع البيانات الضخمه هيسبب بطئ شديد biggrin2
كما ان النتائج غير دقيقه
بمعنى أخر هيحصل أخطاء فى النتائج فى بعض الظروف جرب وشوف wink_3
تقبل وافر احترامى وتقديرى 81

أثارت هذه المشاركة إعجاب: salim، YasserKhalil،




10-10-2018 10:50 مساء
مشاهدة مشاركة منفردة [11]
salim
menu_open
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 235
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
يتابعهم : 13
يتابعونه : 8
قوة السمعة : 2347
الاعجاب : 528
 offline 
look/images/icons/i1.gif استخراج القيم المكررة فقط
اعتذر عن الخطأ في الاسم أستاذ إسلام
لقد قمت بتجربة الكود على 500 صف والنتائح دقيقة  وضعت عامود لحساب التكرار فلم اجد اي رقم يساوي 1
ارجو أعلامي اين يمكن للخطا ان يكون
الملف مرفق

 




لرؤية الروابط والمرفقات عليك الرد على الموضوع


أثارت هذه المشاركة إعجاب: YasserKhalil، Eslam Abdullah،




11-10-2018 01:15 صباحا
مشاهدة مشاركة منفردة [12]
Eslam Abdullah
menu_open
مشرف على لغات برمجة آخرى
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 03-10-2017
رقم العضوية : 852
المشاركات : 1286
الجنس : ذكر
تاريخ الميلاد : 1-9-1995
الدعوات : 3
يتابعهم : 3
يتابعونه : 63
قوة السمعة : 7778
الاعجاب : 2215
 offline 
look/images/icons/i1.gif استخراج القيم المكررة فقط
مشكور مساهماتك المميزه استاذ سليم
فقط احذف خلايا فى بداية او منتصف النطاق وتابع النتائج
وتترتب هذه النتائج لاعتماد الكود على تحديد النطاق باسلوب CurrentRegion

أثارت هذه المشاركة إعجاب: YasserKhalil، salim،





المواضيع المتشابهه
عنوان الموضوع الكاتب الردود الزوار آخر رد
استخراج السن فى 1/10 yehya mahmoud
8 140 نصر الإيمان
كيفية استخراج الدالة Ahmed Samir
3 151 السعيد الجزائري
استخراج القيم الفريدة وفق بيان محدد بالدالة المعرفة AlsaqrUnique Eslam Abdullah
14 1294 Abo Sohaib
استخراج البيانات واحضارها بصورة تقرير عبدالله فتحى
28 472 YasserKhalil
كيفية استخراج البيانات من قائمة منسدلة بكود vba emad eldwady
5 190 YasserKhalil

الكلمات الدلالية
استخراج ، القيم ، المكررة ،


 







اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.



الساعة الآن 02:56 صباحا

أعلن هنا
أعلن هنا
أعلن هنا