تصحيح الخطا في كود الغاء دمج الخلايا

[صباح حسين]

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

اتصور باني لم اوفق في طرح مطلبي بالمشاركة السابقة لذلك قمت بتغير صيغة السؤال مع ارفاق ملف لغرض توضيح المشكلة وتصحيح الخطأ

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

وقمت قمت بعدة محاولات ولم افلح لذلك وكالعادة لا ملجأ لنا نحن المبتدئين ولا عون الا من خلال منتداكم

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

اتمنى باني لم اثقل عيكم

تحياتي لجميع الاعضاء والمشرفين

دمج خلايا.rar

[عبد الفتاح كيرة]

هذا كود إلغاء دمج الخلايا بكل الصفحة" وهو للأخ أيسم"

أما نسخ قيمة الخلايا المدموجة للخلايا الفارغة بعد الدمج

فشأن آخر

نحتاج لوقت

Application.ScreenUpdating = False

Dim AYSAM As Range

Set AYSAM = ActiveSheet.UsedRange

For Each cel In AYSAM

If cel.MergeCells = True Then

cel.UnMerge

cel.Copy cel.Offset(0, 1)

End If

Next

Application.ScreenUpdating = True

Cells.Select

Cells.EntireColumn.AutoFit

تم تعديل فبراير 19, 2011 بواسطه kemas

[صباح حسين]

شكرا اخي لتجاوبك معي سوف اكون بالانتظار

[الحسامي]

السلام عليكم

اخي الكريم جرب هذا الحل

Dim rng As Range, rng2 As Range

For Each rng In [a1:h17]

 If rng.MergeCells Then

 Set rng2 = rng.MergeArea

 rng.MergeArea.UnMerge

 rng2.Value = rng.Value

 End If

Next rng

تحياتي للجميع

دمج.rar

[عبد الفتاح كيرة]

شكرا أخانا الحسامى على هذا الإبداع

بارك الله فيك

ما فائدة هذا السطر؟

rng2.Value = rng.Value

تم تعديل فبراير 19, 2011 بواسطه kemas

[الحسامي]

السلام عليكم

اخي كيماس آلية عمل الكود كالتالي

ايجاد مجموعة خلايا مدمجة معينة

تم تحديد هذه الخلايا كمجوعة غير مدمجة MergeArea ووضعها في متغير اسميناه rng2

اي لواعتبرنا ان a1:a5 خلايا مدمجة ويتم التعرف عليها على اساس انها خلية واحدة فقط وهي الخلية الاولى فقط وهي a1

اما اذا استخدمنا MergeArea فسيعتيرها الخلايا الخمس جميعها بحيث

اذا قلنا ان (على اعتبار ان a1:a5 خلايا مدمجة اسميناها rng2 )

 Set rng2 = rng

فسيعتبر ان rng2 عبارة عن الخلية الاولى فقط وهي a1 اما اذا استخدمنا

 Set rng2 = rng.MergeArea

فسيعتبر rng2 عبارة عن الخلايا الخمس المدمجة جميعا وهي a1:a5 ولذلك استعملنا السطر

 rng2.Value = rng.Value

وقام بجعل الخلايا بعد الاندماج تساوي قيمة الخلية الاولى

[صباح حسين]

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

[عبد الفتاح كيرة]

نفترض أن خمسة خلايا مدموجة تساوى قيمة واحدة هى qq

فالسطر التالى يجعل rng2 = qq و هذا من ناحية عدد الخلايا فقط و ليس قيمتها

Set rng2 = rng.MergeArea

أما قيمة هذه الخلايا فيحددها السطر التالى

rng2.Value = rng.Value

شكرا للتوضيح

تم تعديل فبراير 19, 2011 بواسطه kemas

[عبد الفتاح كيرة]

لعموم الفائدة

هذه تعليقات بسيطة توضح الكود

شكرا للأستاذ الحسامى على الكود الرائع

Private Sub CommandButton1_Click()

Dim rng As Range, rng2 As Range

For Each rng In [a1:h17]

   'شرط العمل أن تكون الخلية مدموجة

    If rng.MergeCells = True Then

       ' المدى rng2 = مكان خلايا منطقة الدمج

        Set rng2 = rng.MergeArea

       'فك الدمج

        rng.MergeArea.UnMerge

        ' المدى rng2 كل خلية فيه تساوى قيمة الخلية المدمجة

        ' يعنى هذا هو سطر النسخ

        rng2.Value = rng.Value

    End If

Next rng

End Sub

[الحسامي]

السلام عليكم

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

شرح جميل ومفيد و100 100

وبالضبط هذا هو عمل الكود بالفعل

وخير الكلام ما قل ودل

بارك الله فيك ... وبالتوفيق

[الشيباني1]

اخواني الاعزاء اشكركم على تجاوبكم السريع حلول رائعه جزاكم الرحمن كل خير

[MSTG3D]

السلام عليكم

اخواني الأعزاء انا كنت مسوي بحث لحل مثل هذه النقطه وحصلت الحل بالمنتدى عندكم

وطبقته وضبط معاي البرنامج وفكني من مهمه شاقه لبيانات عددها فوق الـ 6000 تحوي بعض القيم المدموجه

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

[عبد الفتاح كيرة]

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

والله يا أخى هذا شىء يسعدنا و يفرحنا