كود نسخ الاسماء المتكررة من خلال خلية بحث

[أنس دروبي]

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

 

أساتذتي الكبار والعملاقة استنجدكم بعد الله عزوجل بهذا الطلب

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

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

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

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

فما كان لي الا أن أسأل اساتذتي الكبار في منتدانا المتميز لأجد الحل

وعرض الافكار

في الملف المرفق يوجد مثال بسيط عن البيانات والمطلوب

وشكراً

 

نسخ الاسماء المتكررة من خلال خلية بحث.rar

تم تعديل نوفمبر 20, 2013 بواسطه Creation World

[ابو اياد ( الاسيوطى )]

الاخ // Creation World

 

ارجو ان ترفق لنا الطريقه بالمعادلات اريد ان اطلع عليها

 

بارك الله فيكم

[أنس دروبي]

السلام عليكم

أخي محمود الأسيوطي يشرفني أن تكون من أول المشاركين في الموضوع

 

طريقة المعادلات هي:

1. فلترة البيانات عن طريق الفلترة الأفتراضية

2. معادلة sumproduct لإظهار العدد الاجمالي للتكرار

3.كود يقوم بنسخ العمود المفلتر بكامله الى عمود أخر وهو(عمود نسخ الاسماء المتكررة)

ولكن أخي محمود هذه الطريقة ليست احترافية وطويلة جداً

 

الذي  أريد كود يجمع الثلاثة معاً

كود البحث وبعدها إظهار ونسخ الاسماء المتكررة في عمود أخر وظهور بعدها العدد الاجمالي للتكرار

 

الملف المرفق أخي هو عبارة عن ملف جزئي لشي أخر وبيانات أخرى.

وشكراُ

أخوكم طالب العلم

أنس دروبي

[ابو اياد ( الاسيوطى )]

الاخ // انس

 

الشرف لنا نحن بمعرفتكم والمشاركه فى موضوعكم

 

ولكن لا يوجد مرفق

 

انتظرك

[أنس دروبي]

أخي محمود

القصد عن الملف المرفق الأول

صراحة أنا كنت عامل الطريقة منذ تقريبا شهر

وهي كما قلت في المشاركة السابقة نفس الخطوات

ولكن بحثت عن الملف لم أجده أن شاء الله أذا فضيت اعمله وأرفقه لك

ولكن نريد الطريقة الآن بكود جامع للطريقة

وشكراً

[عبدالله باقشير]

السلام عليكم

 

اذا كانت طريقة البحث اسم مطابق

لماذا يحتاج تكرارها في عمود للنتائج ؟

اظن يكفي عددها فقط

 

اما اذا كان شي ثاني فارجوا التوضيح

 

تفضل الكود التالي

Sub Macro1()
Dim Lr As Long
Dim txt As String
With Range("C2")
    Range(.Cells, .Cells.End(xlDown)).ClearContents
End With
txt = [B2]
Lr = Cells(Rows.Count, "A").End(xlUp).Row
Lr = WorksheetFunction.CountIf(Range("A2:A" & Lr), txt)
If Lr Then
    Range("C2").Resize(Lr).Value = txt
    Range("D2").Value = Lr
End If
End Sub

تحياتي

[أنس دروبي]

 

السلام عليكم

 

اذا كانت طريقة البحث اسم مطابق

لماذا يحتاج تكرارها في عمود للنتائج ؟

اظن يكفي عددها فقط

 

اما اذا كان شي ثاني فارجوا التوضيح

 

 

 

 

السلام عليكم 

أخي عبد الله باقشير أنت تعرف مدى محبتك في قلبي نظراً لأفضالك الكبيرة في مجال الإكسيل

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

ولكن طرحت موضوع القسم الأول نظراً لبساطته بعض الشيْ ولكن الطلب الكامل أخي هو بالتفصيل:

 

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

وكانت هذه الاسماء تعبر عن موعد تأجير السيارة وتاريخ استلامها للزبون وتاريخ أرجاعها وقيمة الأجرة.

ولكن هذه البيانات مربوطة مع فورم إدخال وهذا الفورم يوجد فيها خانة أضافة زبون مثل (إضافة حساب)

وتدخل هذه البيانات واحدة تلو الأخرى بالترتيب.

 

فكان الطلب الكامل من صديقي أنه في حال يريد تعديل اسم زبون ما مثلاً (anas)

وهذا الزبون لديه اكثر من حركة واحدة لايتم تعديل الحركات القديمة في قاعدة البيانات وإنما تظل مثل ماهي على اسم زبون أخر

وفي الحركات الجديدة يظهر الاسم الجديد

 

فكيف نعدل البيانات القديمة على الاسم الجديد المعدل بحيث يظل مكانها نفسه لا تتغير

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

 

أرجو ان تكون وصلت الفكرة والمطلوب

أرجو عرض الأفكار والأراء

 

أخوكم أنس دروبي

تم تعديل نوفمبر 20, 2013 بواسطه Creation World

[أنس دروبي]

أخي عبد الله باقسير

الله يبارك فيك

الكود أعطى المطلوب

الرجاء النظر في المشاركة رقم7

وعرض الأفكار والأراء

تم تعديل نوفمبر 20, 2013 بواسطه Creation World

[يوسف السيد]

السلام عليكم :

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

[أنس دروبي]

أخي يوسف السيد

هذا هو المطلوب كما تفضلت

وشكراً

[عبدالله باقشير]

السلام عليكم

 

جرب هذا الكود

Sub kh_Replace()
Dim NamOld As String, NamNew As String
Dim Lr As Long
NamOld = "hseen"
NamNew = "khboorkheer"
Lr = Cells(Rows.Count, "A").End(xlUp).Row
Range("A2:A" & Lr).Replace _
What:=NamOld, Replacement:=NamNew, _
SearchOrder:=xlByColumns, MatchCase:=True
End Sub

تحياتي

[أنس دروبي]

السلام عليكم 

الله الله الله أكبر

والله ياأخي عبد الله أنت شرف وقدوة ومعلم كبير لهذا الموقع

والله اللسان عاجز عن شكر المعروف الذي قدمته

 

ولكن أخي عبد الله 

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

في هذه الحالة ألغيت خلية البحث

وكان الشرط هو عن طريق البيانات التي كتبت في خليه البحث يتم التبديل

ثانياً: لوسمحت لي وتكرمت علي كود الجمع لم يوجد 

كود الجمع ضروري جداً يبين عدد التغيرات التي حصلت على الاسم القديم في هذه الحالة نعرف كم حركة سجلت عليه

 

الله يبارك فيك وبأولادك والذرية الصالحة لديك

وشكراً

[أنس دروبي]

Sub kh_Replace()
Dim NamOld As String, NamNew As String
Dim Lr As Long
NamOld = Sheets("code").Range("b2")
NamNew = Sheets("code").Range("b3")
Lr = Cells(Rows.Count, "A").End(xlUp).Row
Range("A2:A" & Lr).Replace _
What:=NamOld, Replacement:=NamNew, _
SearchOrder:=xlByColumns, MatchCase:=True
End Sub

اخي عبد الله قمت بحلها 

الباقي فقط كود العدد الاجمالي للتغييرات

وشكراً

تم تعديل نوفمبر 21, 2013 بواسطه Creation World

[عبدالله باقشير]

السلام عليكم

 

الباقي فقط كود العدد الاجمالي للتغييرات

 

اريدك ان تعملها انت بنفسك

لان الحل موجود في الكود الاول

حاول وانا ان شاء الله معاك

 

تحياتي

[أنس دروبي]

الله يبارك فيك اخي عبد الله

كود الجمع عرفته موجود كما ذكرت في الكود الاول

وهو عبارة عن معادلة جمع

الله يبارك فيك

تم حل الموضوع بالكامل

وشكرا

انس دروبي

تم تعديل نوفمبر 21, 2013 بواسطه Creation World