Abuelkhasem قام بنشر أبريل 28, 2015 مشاركة قام بنشر أبريل 28, 2015 (معدل) السلام عليكم المطلوب دالة تقوم بعد الارقام في ورقة اكسل و كتابتها في خلية واحدة و عدم كتابة المكرر الا مرة واحدة. مثال موجود بالمرفق مع خالص الشكرexample.rar تم تعديل أبريل 28, 2015 بواسطه aakr رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر أبريل 28, 2015 مشاركة قام بنشر أبريل 28, 2015 الأخ الكريم يرجى تغيير اسمك للغة العربية لسهولة التواصل إليك الملف التالي لعله يكون المطلوب Sub UniqueValuesWithinRangeIntoOneCell() Dim Rng As Range, DN As Range, N As Long, SP As Variant Set Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp)) With CreateObject("Scripting.Dictionary") .CompareMode = vbTextCompare For Each DN In Rng SP = Split(DN.Value, ",") For N = 0# To UBound(SP) .Item(SP(N)) = Empty Next N Next DN Range("D5").Value = Join(.Keys, ",") End With End Sub لا تنسى أن تحدد المشاركة كأفضل إجابة إذا أعجبتك تقبل تحياتي Unique Values Within Range Into One Cell.rar رابط هذا التعليق شارك More sharing options...
Abuelkhasem قام بنشر أبريل 28, 2015 الكاتب مشاركة قام بنشر أبريل 28, 2015 شكرا سيد ياسر على الرد. لدي بعض الاسفسارات اذا مافيش مانع : 1- كيف يمكنني ان اطبق هالكود على رينج محدد من الخلايا غير الموجود بالمثال. مثلا من B1 الى B10 2- هل بالامكان ان يكون الحساب بصورة مباشرة عند حدوث اي تغيير في البيانات بدون الضغط على زر الكود و شكرا مجددا على تعاونك رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر أبريل 28, 2015 مشاركة قام بنشر أبريل 28, 2015 أخي الكريم عند إرفاق ملف في الموضوع يراعى أن يكون مطابق للملف الأصلي يمكن تطبيق الكود على أي نطاق Set Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp)) من خلال هذا السطر تم تعيين النطاق الذي بدايته A2 ونهايته أخر خلية بها بيانات في العمود الاول إذا كان النطاق الخاص بك ثابت من B1:B10 يمكنك استبدال السطر السابق بهذا السطر Set Rng = Range("B1:B10") أما بالنسبة لطلبك الثاني فهو ممكن ولكن يجب تحديد النطاق الذي إذا تغيرت أي قيمة فيه يبدأ تنفيذ الكود يمكن مراجعة الرابط التالي بخصوص هذا الطلب تقبل تحياتي رابط هذا التعليق شارك More sharing options...
أفضل إجابة ياسر خليل أبو البراء قام بنشر أبريل 28, 2015 أفضل إجابة مشاركة قام بنشر أبريل 28, 2015 أخي الفاضل إليك حل آخر باستخدام دالة معرفة UDF Function UnQ(rng As Range) As String Dim Dn As Range, n As Long, Sp As Variant With CreateObject("scripting.dictionary") .CompareMode = vbTextCompare For Each Dn In rng Sp = Split(Dn.Value, ",") For n = 0# To UBound(Sp) .Item(Sp(n)) = Empty Next n Next Dn UnQ = Join(.Keys, ",") End With End Function تقبل تحياتي Unique Values Within Range Into One Cell.rar رابط هذا التعليق شارك More sharing options...
Abuelkhasem قام بنشر أبريل 28, 2015 الكاتب مشاركة قام بنشر أبريل 28, 2015 رحم الله والديك و زادك في علمك و نفعك و نفعنا به هذا بالتحديد ما ابحث عنه 1 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.