اذهب الي المحتوي
أوفيسنا

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


الردود الموصى بها

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

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

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

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

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

 

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

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

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

 

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

 

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

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

 

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

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

 

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

 

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

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

 

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

=GetUnique(A1:A30)

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

 

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

 

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

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

.Sort

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

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

Get Unique UDF Function.rar

  • Like 5
رابط هذا التعليق
شارك

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

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

تم تعديل بواسطه صلاح الدين الأيوبى
رابط هذا التعليق
شارك

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

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

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

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

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

رابط هذا التعليق
شارك

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

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

 

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

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

 

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

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

  • Like 1
رابط هذا التعليق
شارك

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

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

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

رابط هذا التعليق
شارك

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

جزاك الله خير

داله رائعه

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

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

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

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

بحثت حتى تعبت

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

رابط هذا التعليق
شارك

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

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

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

  • Like 1
رابط هذا التعليق
شارك

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

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

 

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

تقبل تحياتي

  • Like 2
رابط هذا التعليق
شارك

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

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

رابط هذا التعليق
شارك

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

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

753664234.jpg

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

 

تقبلوا عشائي

  • Like 1
رابط هذا التعليق
شارك

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

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

753664234.jpg

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

 

تقبلوا عشائي

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

  • Like 1
رابط هذا التعليق
شارك

  • 1 year later...

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

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

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

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

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

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

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

تم تعديل بواسطه وائل أبو عبد الرحمن
رابط هذا التعليق
شارك

السلام عليكم

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

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

  • Like 1
رابط هذا التعليق
شارك

  • 1 month later...
  • 8 months later...

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


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
 

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

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

 

  • Like 1
رابط هذا التعليق
شارك

  • 6 months later...
  • 2 months later...
  • 5 years later...
في 26‏/5‏/2015 at 10:36, ياسر خليل أبو البراء said:

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

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

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

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

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

 

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

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

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

 

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

 

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

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

 

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

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

 

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

 

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

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

 

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

=GetUnique(A1:A30)

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

 

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

 

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

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

.Sort

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

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

Get Unique UDF Function.rar

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

لقطة شاشة 2023-08-18 093523.png

رابط هذا التعليق
شارك

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

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

  • Like 1
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information