استخراج القيم الغير مكررة مع إمكانية ترتيب القيم Sort

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

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

إخواني الكرام في المنتدى الحبيب

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

رابط الموضوع المتعلق بشبيهة الدالة

فاصل ونواصل (أصلي تعبت ... )

 

دا شكل الدالة المعرفة

Function GetUnique(R As Range)
    Dim Cl As Range, J As Long
    With CreateObject("System.Collections.ArrayList")
    
        For Each Cl In R.Cells
            If Cl <> "" Then If Not .contains((Cl.Value)) Then .Add (Cl.Value)
        Next
        .Sort
        For J = 1 To R.Count
            .Add ("")
        Next J
        GetUnique = Application.Transpose(.toarray())
    
    End With
End Function

ايه رأيكم في شكلها (أنا شايف إنها شكلها لطيف ...مش كدا يا أبو يوسف)

 

تقوم الدالة المعرفة UDF والتي تسمى GetUnique ، باستخراج القيم الغير مكررة في نطاق أي القيم الفريدة في نطاق ، والجديد والمفيد أنه يمكن ترتيب القيم لتحصل في النهاية على قائمة منقحة ومصححة وخالية من التكرار والفراغات .. كل دا بضربة واحدة (ضربة معلم ..صح يا حوسو)

 

إذاً وظيفة الدالة : الحصول على قيم فريدة اي غير مكررة - ترتيب النتائج ترتيب أبجدي - التخلص من الفراغات الموجودة في القائمة الأصلية

وبالمثال المرفق سيتضح المقال

 

كيفية عمل الدالة :

بفرض أن القيم المراد استخراج القيم الفريدة منها في العمود الأول في النطاق A1:A30

 

نشوف العمود اللي عايزين نستخرج النتائج فيه وليكن العمود G .. اشمعنا العمود دا بالذات ، عشان العمود ده رقم 7 وأنا من عشاق الرقم 7 ومضاعفاته ..

 

نحدد النطاق من أول الخلية G1 لحد G30 قبل ما نكتب المعادلة

حددنا النطاق (برافو عليك يا حوسو) روح بقا لشريط المعادلات (مش ظاهر معاك يبقا أكيد لعبت في إعدادات الإكسيل .. ودي حاجة مش وحشة دي حاجة حلوة ، لأنها دليل إنك عايز تتعلم .. اظهر شريط المعادلات من التبويب View هتلاقي كلمة Formula Bar جنبه مربع علم عليه ..! مش أحسن ما هو اللي يعلم عليك)

 

ضع المعادلة التالية في شريط المعادلات

=GetUnique(A1:A30)

ومن لوحة المفاتيح اضغط Ctrl + Shift + Enter لأن دي معادلة صفيف ..

 

ومبروك عليك القايمة الجديدة (على أساس إنك متجوز للمرة التانية .. بس القديمة تحلا ولو كانت أحلى ..بلاش نقول وحلة لناخد مخالفة (من خاف سلم))

 

طيب دلوقتي أنا سامع واحد بيقولي إنت ليه بتجبرني إني أرتب القيم (أنا عايز القيم زي ما هي بدون تكرار وبدون فراغات بس الترتيب ميلزمنيش) ..

أرد عليه وأقوله ولا تزعل نفسك يا حبيبي روح لمحرر الأكواد ودور على السطر اللي جاي ده واحذفه أو ضع بجانبة تعليق .. بس خلاص ! مش دي اللي هتزعلنا من بعضنا )

.Sort

وأخيراً تقبلوا تحيات أخوكم أبو البراء

دمتم على طاعة الله

Get Unique UDF Function.rar

[ابوحمزه المصرى]

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

دائما متألق استاذى الكبير ياسر خليل

تم تعديل مايو 26, 2015 بواسطه صلاح الدين الأيوبى

[علي الشيخ]

أستاذ ياسر الله يجزاك خير ويزيدك من علمه ونفع بك

دائما لديك كل جديد ومفيد وفي انتظار المزيد دائما

دمت بخير

[محمد حسن المحمد]

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

قال الله تعالى لنبينا محمد صلى الله عليه وسلم: " وإنك لعلى خلق عظيم " أي أن رسولنا صلى الله عليه هو في قمة الخلق الرفيع ...

أما من حيث العلم ، فقد قال له: " وقل ربّ زدني علماً " فالعلم في ازدياد مضطرد ولن نبلغ ذروته مهما اجتهدنا ولذلك فإنني أقول لأخوتي عموماً ولأخي أبو البراء خصوصاً:

( اللهم اجعلهم ممن طال عمره وحسن عمله...اللهم زدهم علماً وحلماً.....آمين)..

أخوكم أبو يوسف.

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

الأخ الحبيب صلاح الدين الأيوبي

بارك الله فيك وجزيت خيراً بمثل ما دعوت

 

الأخ الغالي النجم المتألق علي الشيخ

زادني الله وإياكم علماً وجزيتم خيراً على مروركم العطر

 

الأخ والأب الحبيب أبو يوسف

لكم تسعدني ردودك وكلماتك الطيبة ودعائك الطيب ..بارك الله فيك ولك بمثل ما دعوت إن شاء الله

[Yasser Fathi Albanna]

هاتفضل دائما وأبدا رائع أخى الحبيب الغالى / ياسر خليل

جزاك الله كل الخير وأدام عليك الصحة والعافية

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

أخي الغالي الباشمهندس الحبيب ياسر

مشكور عىل كلماتك الرقيقة وشعورك النبيل

جزيت خيراً على مرورك المتألق بموضوعاتي

[saad abed]

اخى ابوالبراء

جزاك الله خير

داله رائعه

حاولت استخدامها ولكنها تظهر العمود كما هو بالتكرار

اعلم انها داله صفيف

شرح واضح ماشاء الله

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

بحثت حتى تعبت

ماذا تتوقع انصحنى

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

أخي الفاضل سعد

هل حددت النطاق بالكامل أولاً ..يجب تحديد نطاق النتائج بالكامل قبل إدراج المعادلة بمعني لو عايز النتائج في النطاق H1:H30 يبقا تحدد النطاق بالكامل وتروح لشريط العنوان وتضع المعادلة ومن لوحة المفاتيح تضغط Ctrl + Shift + Enter

أو ارفق ملفك للإطلاع عليه

[saad abed]

شكرا اخى ياسر

تمت العملية بنجاح

اذن لابد من تحديد النطاق بالكامل

ثم اضغط ctr+shift+enter

اشكرك اخى ياسر

داله خطيره

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

أخي الحبيب سعد .. ابقا اقرا وتابع الشرح كويس بعد كدا

عشان أنا راعيت إني مفوتش حاجة ...

 

لو اتكرر الأمر بعد كدا هنغرمك (عشا    لكل الموجودين بالمنتدى)

تقبل تحياتي

[محمد حسن المحمد]

الحمد لله رب العالمين .....عشاء مع فارق التوقيت ...وكل واحد يصله لبلده غرامة كبيرة ....تحتاج لميزانية بلد والله أعلم.....

إذا أردت أن تطاع فأمر بالمستطاع...أثقلت كاهله .

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

أخي الحبيب محمد حسن أبو يوسف

خلاص بلاش نتقل عليه ، والعشا عندي اتفضلوا

بالهنا والشفا

 

تقبلوا عشائي

[محمد حسن المحمد]

أخي الحبيب محمد حسن أبو يوسف

خلاص بلاش نتقل عليه ، والعشا عندي اتفضلوا

بالهنا والشفا

 

تقبلوا عشائي

السلام عليكم صحتين وهناء ....الفاكهة بالنظر ...مجرد رؤية هذه المائدة الطيبة...اللهم أدمها نعمة واحفظها من الزوال....اللهم أطعم من أطعمنا واسق من سقانا....سفرة دايمة إن شاء الله

[ًعبد من عباد الله]

الأخ والاستاذ الكريم أبو البراء

ما شاء الله ولا قوة إلا بالله دائما تتفرد بما فتحه الله عليك من علم وحلم

أخى الكريم اسمح لى بطلب تعديل على عملك الجميل هذا فلقد وجدته وأنا أبحث عن عمل مشابه لطبيعة عملك هذا واوفقك الرأى أنها فعلا (ضربة معلم) وأنا بطبيعتى أحب هذه الأعمال التى تصيب أكثر من عصفور لضربة واحدة لأنها توفر الوقت والجهد وتقلل من حجم التشتت بين كثرة الملفات فبارك الله فيكم ونفع بكم وما أريده ينحصر في 3 نقاط:-

1- أن تكون النتيجة المخرجة في ورقة عمل أخرى بنفس ترتيب الأعمدة في ورقة العمل الرئيسية المحتويه للبيانات وليس فى عمود أخر في نفس الورقة كما في عملكم .

2- ورقة العمل الرئيسية التى سيجرى عليها البحث عن المتكرر وتصفيته بالترتيب دون فراغات بها عدة أعمدة والعمود المراد التخلص من التكرار فيه سيكون العمود I فأريد في ورقة عمل النتيجة ان يأخذ معها الأعمدة المرتبطة بالعمود I أى بقية بياناته الموجودة في نفس صفه.

3- اريد في أليه البحث عن المتكرر في الكود ان تستطيع التفرقة بين الجمل التى سيكون فيها الكلمات المكتوبة بالهاء والكلمات المكتوبة بالتاء المربوطة وبين الياء المنتهية بنقطتين والياء العادية والألف غير المهموز والألف المهموز لنفس الكلمات في الجمل التى بها تكرار ولكن بين كلماتها هذه الاختلافات لهذه الحروف وبمعنى أخر هل يستطيع الكود اعتبار هذه الجمل متكرره برغم ما بين بعض حروفها من تغيير أم أنه فقط يلتزم بالتعرف على الجمل المتكررة حرفيا (التوأم).

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

تم تعديل نوفمبر 12, 2016 بواسطه وائل أبو عبد الرحمن

[طلعت محمد حسن]

السلام عليكم

دئما استاذنا العزيز ياسر خليل المرجع الاول لنا بأفكارك النيرة وروحك الجميلة بارك الله فيك وجزاك كل خير

اقبل تحياتي واحترامي

[صلاح الدين المصلح]

قمة العطاء ما شاء الله تبارك الله رب العالمين.

[ناصر سعيد]

استاذ ياسر خليل
السلام عليكم ورحمة الله وبركاته
جزاك الله خيرا وبارك فيك .. آمين يارب العالمين
وبعد :

Sub القيم_الفريده()
'هذا الكود تم بواسطه المحترم ياسر خليل
'الهدف من الكود
'الاتيان بالقيم الفريده لبيانات في عمود
'تم في 31/8/2017
    Dim rng     As Range
    Dim a       As Variant
    Dim ws      As Worksheet
    
    'اسم الخليه في صفحه الهدف
    ' التي ستظهر بها القيم القريده
  Const strTRng  As String = "D4"
 
    'في صفحه الهدف العمود المطلوب
  ' وضع القيم الفريده فيه
    Const strHRng As String = "D4:D1000"
 
  'في صفحه المصدر العمود المطلوب
  ' استخراج القيم الفريده منه
    Const strSRng  As String = "C10:C200"
    
        'اسم الشيت في صفحه المصدر
    Const str   As String = "Sheet1"
      
    Set ws = Sheets(str)
'======================
    'نفترض وجود بيانات كأسماء في النطاق المذكور
    Set rng = ws.Range(strSRng)
   ActiveSheet.Range(strHRng).ClearContents
   
    'تخزين النتائج في مصفوفة
    a = GetDistinct(rng)
    
    'النطاق المطلوب وضع النتائج للأسماء الغير مكررة فيه
    ActiveSheet.Range(strTRng).Resize(UBound(a, 1) + 1) = Application.Transpose(a)
    
'فرز العمود المنقول اليه القيم الفريده
  [D4:D200].Sort [D4], xlAscending
 
  'عمود القيم الفريده ستتم عليه بعض التنسيقات
   With ActiveSheet.Range(strHRng)
   
   'تنسيق العمود تكست
.EntireColumn.NumberFormat = "@"
.Font.Bold = True
.ReadingOrder = xlRTL: .HorizontalAlignment = xlCenter: .VerticalAlignment = xlCenter

End With
    
End Sub

Function GetDistinct(ByVal oTarget As Range) As Variant
    Dim dic         As Object
    Dim vArr        As Variant
    Dim v           As Variant

    Set dic = CreateObject("Scripting.Dictionary")
    vArr = oTarget

    For Each v In vArr
        If Not IsEmpty(v) Then dic(v) = v
    Next v

    GetDistinct = dic.Items()
End Function

 

================

منقول للافاده 

 

[ناصر سعيد]

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

[jameel2411]

معك ابو عبد العزيز م السعودية وعندي بعض التصاميم محتاجه منك وكيف طريقة التواصل معك  

jameel150150@gmail.com

[رحااال]

في 26‏/5‏/2015 at 10:36, ياسر خليل أبو البراء said:

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

إخواني الكرام في المنتدى الحبيب

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

رابط الموضوع المتعلق بشبيهة الدالة

فاصل ونواصل (أصلي تعبت ... )

 

دا شكل الدالة المعرفة

Function GetUnique(R As Range)
    Dim Cl As Range, J As Long
    With CreateObject("System.Collections.ArrayList")
    
        For Each Cl In R.Cells
            If Cl <> "" Then If Not .contains((Cl.Value)) Then .Add (Cl.Value)
        Next
        .Sort
        For J = 1 To R.Count
            .Add ("")
        Next J
        GetUnique = Application.Transpose(.toarray())
    
    End With
End Function

ايه رأيكم في شكلها (أنا شايف إنها شكلها لطيف ...مش كدا يا أبو يوسف)

 

تقوم الدالة المعرفة UDF والتي تسمى GetUnique ، باستخراج القيم الغير مكررة في نطاق أي القيم الفريدة في نطاق ، والجديد والمفيد أنه يمكن ترتيب القيم لتحصل في النهاية على قائمة منقحة ومصححة وخالية من التكرار والفراغات .. كل دا بضربة واحدة (ضربة معلم ..صح يا حوسو)

 

إذاً وظيفة الدالة : الحصول على قيم فريدة اي غير مكررة - ترتيب النتائج ترتيب أبجدي - التخلص من الفراغات الموجودة في القائمة الأصلية

وبالمثال المرفق سيتضح المقال

 

كيفية عمل الدالة :

بفرض أن القيم المراد استخراج القيم الفريدة منها في العمود الأول في النطاق A1:A30

 

نشوف العمود اللي عايزين نستخرج النتائج فيه وليكن العمود G .. اشمعنا العمود دا بالذات ، عشان العمود ده رقم 7 وأنا من عشاق الرقم 7 ومضاعفاته ..

 

نحدد النطاق من أول الخلية G1 لحد G30 قبل ما نكتب المعادلة

حددنا النطاق (برافو عليك يا حوسو) روح بقا لشريط المعادلات (مش ظاهر معاك يبقا أكيد لعبت في إعدادات الإكسيل .. ودي حاجة مش وحشة دي حاجة حلوة ، لأنها دليل إنك عايز تتعلم .. اظهر شريط المعادلات من التبويب View هتلاقي كلمة Formula Bar جنبه مربع علم عليه ..! مش أحسن ما هو اللي يعلم عليك)

 

ضع المعادلة التالية في شريط المعادلات

=GetUnique(A1:A30)

ومن لوحة المفاتيح اضغط Ctrl + Shift + Enter لأن دي معادلة صفيف ..

 

ومبروك عليك القايمة الجديدة (على أساس إنك متجوز للمرة التانية .. بس القديمة تحلا ولو كانت أحلى ..بلاش نقول وحلة لناخد مخالفة (من خاف سلم))

 

طيب دلوقتي أنا سامع واحد بيقولي إنت ليه بتجبرني إني أرتب القيم (أنا عايز القيم زي ما هي بدون تكرار وبدون فراغات بس الترتيب ميلزمنيش) ..

أرد عليه وأقوله ولا تزعل نفسك يا حبيبي روح لمحرر الأكواد ودور على السطر اللي جاي ده واحذفه أو ضع بجانبة تعليق .. بس خلاص ! مش دي اللي هتزعلنا من بعضنا )

.Sort

وأخيراً تقبلوا تحيات أخوكم أبو البراء

دمتم على طاعة الله

Get Unique UDF Function.rar

ظهر لي الملف كما تشاهد 🙂

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

استخدام System.Collections.ArrayList يلزم أن يكون مسطب لديك النت فريم ورك 3.5 

إذا قمت بتسطيب النت فريم ورك واستمرت المشكلة ، قم بإرفاق الملف الذي به المشكلة للإطلاع عليه