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

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


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





استخراج القيم المكررة والفريدة معا

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



22-05-2020 02:12 مساء
محمدمطر
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 08-02-2018
رقم العضوية : 4244
المشاركات : 63
الجنس : ذكر
تاريخ الميلاد : 14-11-1976
يتابعهم : 8
يتابعونه : 0
قوة السمعة : 38
 offline 

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

 
 
 
  الاسماء الموجوده فى القوائم.xlsx   تحميل xlsx مرات التحميل :(5)
الحجم :(10.93) KB


23-05-2020 02:29 مساء
مشاهدة مشاركة منفردة [1]
salim
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 33
قوة السمعة : 6607
عدد الإجابات: 67
 offline 
look/images/icons/i1.gif استخراج القيم المكررة والفريدة معا
جرب هذا الملف

Option Explicit
Dim My_sh As Worksheet
Dim Rg As Range, Find_rg As Range
Dim roA%, roB%, Ro, i%, K, ky, m
Dim Dic_A As Object
Dim Rg_A, RG_B
'++++++++++++++++++++++++++++++
Sub Get_alL_data()
Initialize
Range("c2").Resize(Ro * 2, 5).ClearContents
    Common_Names
    In_A_Only
    In_B_Only
    In_A_Only_Plus_In_B_Only
    All_Unique
End Sub
'================================
Sub Initialize()
Set My_sh = Sheets("ورقة1")
Set Dic_A = CreateObject("Scripting.Dictionary")
roA = My_sh.Cells(Rows.Count, 1).End(3).Row
roB = My_sh.Cells(Rows.Count, 2).End(3).Row
Ro = Application.Max(roA, roB)
Set Rg_A = Range("A1:A" & Ro)
Set RG_B = Range("B1:B" & Ro)
End Sub
'=====================================
Sub Common_Names()

For i = 2 To Ro
    If Cells(i, 1) <> vbNullString Then
    Set Find_rg = RG_B.Find(Cells(i, 1), lookat:=1)
     If Not Find_rg Is Nothing Then
      Dic_A(Cells(i, 1)) = vbNullString
     End If
   End If
 Next i
 Cells(2, 3).Resize(Dic_A.Count) = _
 Application.Transpose(Dic_A.keys)
 Dic_A.RemoveAll
End Sub
'=============================
Sub In_A_Only()
For i = 2 To Ro
    If Cells(i, 1) <> vbNullString Then
    Set Find_rg = RG_B.Find(Cells(i, 1), lookat:=1)
     If Find_rg Is Nothing Then
      Dic_A(Cells(i, 1)) = vbNullString
     End If
   End If
 Next i
 Cells(2, 4).Resize(Dic_A.Count) = _
 Application.Transpose(Dic_A.keys)
  Dic_A.RemoveAll
End Sub
'=============================
Sub In_B_Only()
For i = 2 To Ro
    If Cells(i, 2) <> vbNullString Then
    Set Find_rg = Rg_A.Find(Cells(i, 2), lookat:=1)
     If Find_rg Is Nothing Then
      Dic_A(Cells(i, 2)) = vbNullString
     End If
   End If
 Next i
 Cells(2, 5).Resize(Dic_A.Count) = _
 Application.Transpose(Dic_A.keys)
  Dic_A.RemoveAll
End Sub
'================================

Sub In_A_Only_Plus_In_B_Only()
For i = 2 To Ro
  If Cells(i, 1) <> vbNullString Then
    Set Find_rg = RG_B.Find(Cells(i, 1), lookat:=1)
     If Find_rg Is Nothing Then
      Dic_A(Cells(i, 1)) = vbNullString
     End If
   End If
 Next i
 '+++++++++++++++++++++++++++++++++
 For i = 2 To Ro
  If Cells(i, 2) <> vbNullString Then
    Set Find_rg = Rg_A.Find(Cells(i, 2), lookat:=1)
     If Find_rg Is Nothing Then
      Dic_A(Cells(i, 2)) = vbNullString
     End If
   End If
 Next i
 Cells(2, 6).Resize(Dic_A.Count) = _
 Application.Transpose(Dic_A.keys)
  Dic_A.RemoveAll
 End Sub
 '+++++++++++++++++++++++++++++
 Sub All_Unique()

For i = 2 To Ro
  For K = 1 To 2
   Dic_A(Cells(i, K).Value) = ""
  Next K
Next i
 
 Cells(2, 7).Resize(Dic_A.Count) = _
 Application.Transpose(Dic_A.keys)
  Dic_A.RemoveAll
  
End Sub

الملف مرفق
 
 
 
  Working_with columns.xlsm   تحميل xlsm مرات التحميل :(16)
الحجم :(30.312) KB


24-05-2020 05:16 مساء
مشاهدة مشاركة منفردة [2]
salim
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 33
قوة السمعة : 6607
عدد الإجابات: 67
 offline 
look/images/icons/i1.gif استخراج القيم المكررة والفريدة معا
كل عام وانتم بخيريا صديقي
هذا مطلوبك (نفس الشيء بالمعادلات)
تم حماية الخلايا التي تحتوي على معادلات لعدم العبث بها عن طريق الخطأ


 
 
 
  Working_with columns_Formula.xlsm   تحميل xlsm مرات التحميل :(10)
الحجم :(43.501) KB


24-05-2020 06:21 مساء
مشاهدة مشاركة منفردة [3]
محمدمطر
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 08-02-2018
رقم العضوية : 4244
المشاركات : 63
الجنس : ذكر
تاريخ الميلاد : 14-11-1976
يتابعهم : 8
يتابعونه : 0
قوة السمعة : 38
 offline 
look/images/icons/i1.gif استخراج القيم المكررة والفريدة معا
بصراحة ملف رائع ربنا يبارك فيك واسال الله ان يفتح عليكم وربنا يكرمك الا انى اطمع فى شرح الملف فيديو ولعل الله يجعله فى ميزان حسناتكم
 

24-05-2020 07:26 مساء
مشاهدة مشاركة منفردة [4]
salim
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 33
قوة السمعة : 6607
عدد الإجابات: 67
 offline 
look/images/icons/i1.gif استخراج القيم المكررة والفريدة معا
حتى لا تمتد يد المساعدة الى أحد

26-05-2020 06:14 مساء
مشاهدة مشاركة منفردة [5]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10445
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 535
قوة السمعة : 36552
عدد الإجابات: 254
 offline 
look/images/icons/i1.gif استخراج القيم المكررة والفريدة معا
أخي الكريم محمد مطر
الفكرة في الإعجاب هي تقدير الشخص الذي يقدم المساعدة ، مع أن الإعجاب لن يزيد ولن ينقص من الشخص وهو تقدير معنوي لا أكثر ولا أقل ، وهو تعبير عن الشكر والامتنان ، وهو ليس بإجبار عليك .. فإن فعلت فهو خير وسيجعل من يقدم المساعدة يشعر بالقبول ويكثر من تقديم المساعدة (ولا تنسى أن هذا وقت مستقطع من حياته ، فهذا أقل ما يجب فعله تجاه من يقدم المساعدة .. وإلا مع الوقت لن تجد أحداً يمد يد المساعدة للغير)
تقبل وافر تقديري واحترامي

26-05-2020 09:11 مساء
مشاهدة مشاركة منفردة [6]
abouelhassan
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 26-05-2020
رقم العضوية : 19295
المشاركات : 184
الجنس : ذكر
يتابعهم : 6
يتابعونه : 0
قوة السمعة : 418
 offline 
look/images/icons/i1.gif استخراج القيم المكررة والفريدة معا
مشكور استاذ سليم حاجة رائعة جدااااااااااااا




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


 










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

الساعة الآن 07:35 صباحا