دمج الاسماء المكرره

[mmjksa]

اخواني بارك الله فيكم

 

لدي ملف اكسل به الاسم والعمر والمدينة والسنه، الاسم مكرر على عدة سطور.

 

المطلوب بارك الله فيكم، دمج الاسماء المتشابهة ليكون الاسم مكتوب مره واحده حسب المرفق.

 

ولكم تحياتي

test1.rar

تم تعديل أبريل 15, 2013 بواسطه mmjksa

[mmjksa]

بارك الله فيك، ارجو المساعدة في الحل

[جمال عبد السميع]

أنظر المرفق أخى ، بجد متعبة جدا عملية دمج الخلايا مع الفلترة

test1.rar

[شوقي ربيع]

السلام عليكم

اخي جمال عبد السميع  اثابك الله على تعبك الف حسنة 

تحكم وربط جميل بين الدوال

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

[جمال عبد السميع]

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

[mmjksa]

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

 

جاري التجربه .

 

مع تحياتي

[mmjksa]

اخي العزيز جمال عبد السميع، مجهود تشكر عليه،

 

بالنسبة لاسم محمد وناصر النتيجة ممتازة، اما بقية الاسماء فيوجد زيادة اسطر، مثل خالد زايد سطر وسعود زايد سطرين وفهد زايد ثلاثة اسطر فارغة.

 

فكيف التخلص من الاسطر الفارغة ؟؟

 

واكرر شكري وتقديري لك ولمجهودك.

 

مع تحياتي

[جلال محمد]

اخي الكريم 

شاهد المرفق : هل هو المطلوب ؟ 

طريقة أخري بالكود 

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

test3.rar

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

السلام عليكم

 

هذا تعديل لكود جلال

يعمل على الدمج في العمود A

 

Sub kh_Merge()
Dim LR As Long, i As Long, ii As Long
LR = [A1000].End(xlUp).Row
For i = LR To 1 Step -1
    If Application.CountIf(Range("A1:A" & LR), Cells(i, "a")) > 1 Then
        Range("A" & i) = ""
        ii = ii + 1
    Else
        If ii Then
            With Range("A" & i)
                .Resize(ii + 1, 1).Merge
                .VerticalAlignment = xlTop
            End With
        End If
        ii = 0
    End If
Next
End Sub
 

في امان الله

[ايهاب سعيد]

كود الاستاذ عبدالله لم يعمل عندي

مع الشكر والتقدير

[mmjksa]

اخي الكريم 

شاهد المرفق : هل هو المطلوب ؟ 

طريقة أخري بالكود 

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

 

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

 

مع تحياتي

test1.rar

[mmjksa]

اخي عبدالله باقشير الكود لم يعمل معي، لا اعلم ما السبب !!

 

مع تحياتي

[احمد عبد الناصر]

السلام عليكم

 

كود الاستاذ عبد الله باقشير عمل عندي بنسبة  100%

 

جرب المرفق مدمج فيه الكود

 

تحياتي

test3+.rar

[mmjksa]

السلام عليكم

 

كود الاستاذ عبد الله باقشير عمل عندي بنسبة  100%

 

جرب المرفق مدمج فيه الكود

 

تحياتي

 

بارك الله فيكم جميعا على مساعدتي.

 

فعلا المرفق عمل معي،

 

طيب هل بالإمكان دمج العامود E الفارغ مثل العامود A  الخاص بالأسماء،

 

وهل ممكن فرز الاسماء قبل الدمج، لتلافي أي خطاء او نسيان الفرز، مثل المرفق.

 

اشكركم جميعا لتفاعلكم معي.

test1.rar

تم تعديل أبريل 17, 2013 بواسطه mmjksa

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

السلام عليكم

Sub kh_Merge()
Dim LR As Long, i As Long, ii As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
On Error GoTo 1
Application.ScreenUpdating = False
Range("A1:E" & LR).Sort Columns(1), xlAscending
For i = LR To 1 Step -1
    If Application.CountIf(Range("A1:A" & LR), Cells(i, "a")) > 1 Then
        Range("A" & i) = ""
        ii = ii + 1
    Else
        If ii Then
            With Range("A" & i)
                .Resize(ii + 1, 1).Merge
                .VerticalAlignment = xlTop
            End With
            Range("E" & i).Resize(ii + 1, 1).Merge
        End If
        ii = 0
    End If
Next
1:
Application.ScreenUpdating = True
End Sub

في امان الله

[mmjksa]

بارك الله فيك اخي عبدالله باقشير.

 

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

 

مع تحياتي

تم تعديل أبريل 18, 2013 بواسطه mmjksa

[حمادة عمر]

السلام عليكم

الاستاذ القدير العلامة الخبير / عبدالله باقشير

 

بارك الله فيك

كل مشاركة لك درس للجميع نتعلم منها شيئا جديدا

زادك الله من فضله وعلمه

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

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

السلام عليكم

الحمدلله رب العالمين

وشكرا لمرورك العطر اخي حمادة ......حفظكم الله

 

تقبلوا تحياتي وشكري

[mmjksa]

اخواني اكرر عذري لكثرة الاسئلة.

 

صادفت بعد الدمج مشكلة،

وهي عند الترقيم التلقائي  في اخر عامود E  من 1 الى النهاية، لا استطيع الترقيم تظهر رسالة (تتطلب هذه العملية تماثل في حجم الخلايا المدمجة).

 

فما الحل، لا اريد ان ارقم يدوي لان الاسطر كثيرة !!!

 

مع تحياتي

تم تعديل أبريل 18, 2013 بواسطه mmjksa

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

السلام عليكم

تفضل التعديل

Sub kh_Merge()
Dim LR As Long, i As Long, ii As Long, iii As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
On Error GoTo 1
Application.ScreenUpdating = False
Range("A1:E" & LR).Sort Columns(1), xlAscending
For i = LR To 1 Step -1
    If Application.CountIf(Range("A1:A" & LR), Cells(i, "a")) > 1 Then
        Range("A" & i) = ""
        ii = ii + 1
    Else
        If ii Then
            With Range("A" & i)
                .Resize(ii + 1, 1).Merge
                .VerticalAlignment = 2
            End With
            With Range("E" & i)
                .Resize(ii + 1, 1).Merge
                .VerticalAlignment = 2
            End With
        End If
        ii = 0
    End If
Next
For i = 1 To LR
    If Len(Range("A" & i)) Then
        iii = iii + 1
        Range("E" & i).Value = iii
    End If
Next
1:
Application.ScreenUpdating = True
End Sub

في امان الله

[mmjksa]

بارك الله فيك اخي عبدالله باقشير، وجزاك الله خيرا.

 

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

 

اكرر شكري وتقديري لك وللإخوان في هذا المنتدى الرائع والمفيد.

 

مع تحياتي

[ميدو63]

عمل ممتاز

[mmjksa]

استاذ عبدالله باقشير بارك الله فيك.

 

طلب صغير جدا،

ممكن الترقيم يكون في العامود A والاسم في العامود B والعمر في العامود C والمدينة في العامود D والسنة في العامود E.

 

وكذلك دمج الاعمار المتشابهة مع بعض مثل الاسم.

 

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

 

 

مع تحياتي.

 

[mmjksa]

اسف للتكرار.

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

 

مع تحياتي

تم تعديل أبريل 20, 2013 بواسطه mmjksa

[mmjksa]

استاذ عبدالله باقشير بارك الله فيك.

 

 قمت بتعديل على الكود والنتائج جدا ممتازة، ولكن تظهر رسالة مفادها :-

(يحتوي التحديد على قيم بيانات متعددة. سيبقي الدمج في خلية واحدة بيانات الخلية العلوية اليمنى فقط.) اضغط موافق او إلغاء الأمر.

 

كيف التخلص منها بارك الله فيك !!

 

يوجد مرفق صورة الخطاء وملف الاكسل .

 

مع تحياتي

 

test1error2.rar

تم تعديل أبريل 22, 2013 بواسطه mmjksa