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

[حسين بلال]

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

أواجه حالات كثيرة في عملي حيث أنني استلم من البنوك أو الشركات الأخرى كشوف حسابات على صيغة

PDF

فأقوم بتحويلها إلى لاحقة اكسيل بغرض استخدامها في عملي, أواجه مشكلة وهي بأن البرنامج سيقوم بتحويل كل سطر إلى خلية وبالتالي سيكون في السطر الواحد من ملف الأكروبات, أكثر من سطر في ملف الإكيل وغالباُ ماتكون هذه المشكلة بسبب عمود النص والذي يكون فيه كلمات كثيرة كشرح للعملية الموجودة في السطر المحدد, وبالتالي فأنا بمشكلة كبيرة مفادها أنني لن أستطيع القيام بأي عمليات فلترة أو فرز ...... على هذه الصفحة لأني سأفقد البيانات الموجودة في الأسطر الباقية

طيب, المطلوب من فضلكم طبعاً:

أريد ماكروا يقوم بالتالي, لو حددت أكثر من خلية من ضمن عمود واحد, أن يقوم بدمج محتويات الخلايا المحددة مع اضافة فراغ واحد فيما بينهاعلى أن تظهر النتيجة في الخليا العليا, باقي الخلايا فارغة. مثال, لو كانت محتويات الخلايا الثلاثة التالية

A1= How

A2= Are

A3= You

بدون فراغات فيما بينها

بعد تطبيق الماكرو المطلوب, ستكون النتيجة كالتالي

A1= How Are You

A2=A3=empty

طيب, لو تم تحديد أكثر من خلية في سطر وحد, فإنه سيتم وضع القيم التي كانت في الخلايا المحددة بأول خلية من الخلايا المحددة مع الفصل فيما بينها بفراغ واحد مع تفريغ الخلايا الباقية

مثال

A1= How

B1= Are

C1= You

بدون فراغات فيما بينها

بعد تطبيق الماكرو المطلوب, ستكون النتيجة كالتالي

A1= How Are You

B1=C1=empty

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

مثال

A1= How

B1= Are

C1= You

A2= ?

B2= what?

عند تحديد الخلايا

A1:D2

وتطبيق الماكرو المطلوب, فإن النتيجة هي

A1= How Are You ? What?

B1=C1=A2=B2=D2= empty

ملاحظات على الماكرو المطلوب, في حال تحديد خلية أو خلايا فارغة, تعامل معاملة الخلايا المليئة, وذلك بأن يضاف فراغ قبلها وبعدها لأني لا أريد تعقيد العملية كثيراً عليكم.

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

ملاحظة أخيرة, أرجو أن يكون الماكرو قابلاً للإستخدام عن طريق اختصارات الكيبورد وليس عن طريق الأزرار أو فورم وأرجو ألا يحوي الماكرو على أي كلمة عربية كون الأجهزة في المكان الي أعمل فيه لايوجد فيها أي لغة عربية بالغالب الأعظم وبالتالي سيتولد اخطاء من جراء وجود هكذا كلمات ولو كانت اسم الشيت نفسه

جزاكم الله خيراً ووفقكم لما يحب ويرضى

[حسين بلال]

عسى ربي يوفقكم ويكون في حل على ايدكم, الله يجزيكم الخير

[مصطفى كمال]

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

تفضل أخي الملف باستخدام دمج الخلايا بفورم

[مصطفى كمال]

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

تفضل أخي الملف باستخدام دمج الخلايا بفورم

Classeur1.rar

[حسين بلال]

السلام عليكم

بدايةً جزاك الله خيراً ووفقك لما يحب ويرضى.

حملت المرفق لكن لايوجد فيه أي ماكرو, تأكدت من خلال دخولي إلى محرر الفيجوال بيزك, عموماً أرجو منك التأكيد على الملف وارشادي لطريقة عمله, لكن لاحظت من خلال القيم التي أوردتها كمثال بأن النتيجة ستكون في صفحة ثانية لكن الذي جعلني ألجأ لفكرة الماكرو هذه هي عدم رغبتي بالدخول في متاهة النسخ واللصق والحذف لتعديل الملف الذي أعمل عليه لأن هذا الأمر سيأخذ الكثير الكثير من وقتي.

وفقك الله لما يحب ويرضى

[حسين بلال]

جزاكم الله خيراً ووفقكم لما يحب ويرضى

[حسين بلال]

اعتذر عن كثرة الإلحاح لكن السبب حاجتي لما طلبت.

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

[أيمن عمر محمد]

بدون ماكرو استخدم الصيغة الآتية

A1&B1&C1&D1&E1 =

أو ارفع الملف المرفق

أرجو من الله التوفيق أخوكم أيمن عمر

[حسين بلال]

بدون ماكرو استخدم الصيغة الآتية

A1&B1&C1&D1&E1 =

أو ارفع الملف المرفق

أرجو من الله التوفيق أخوكم أيمن عمر

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

أرجو أن يكون الأمر أوضح بالنسبة إليك أخي أيمن

[أيسم إبراهيم]

السلام عليكم

الأخ الكريم

في محاولة مني لمساعدتك و أثناء البحث حصلت على هذا الكود (المنقول)

فقلت ربما يفيدك في طلبك

'Un comment to stop message

'Application.DisplayAlerts = False

With Sheet1 

   Range("F3", Range("F" & Rows.Count).End(xlUp)). Merge

End With

Application.DisplayAlerts = True 

تم تعديل فبراير 10, 2010 بواسطه أيسم إبراهيم

[أبوعبد الله]

أخي العزيز

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

تحياتي

أبو عبدالله

join cells again.rar

[حسين بلال]

السلام عليكم

أخي العزيزي أيسم وأخي أبو عبد الله, جزاكم الله خيراً ووفقكم لما يحبه ويرضاه, لكن الكود من مشاركة أي أخي أيسم لن يفيدني لأنني ليس لدي معرفة كبيرة بكتابة الأكواد, أما مشاركة الأخ أبو عبد الله فهو كود جميل جداً لكن المشكلة أنه سيأكل من وقتي الكثير.

بكل الأحوال, حل الأمر عن طريق رد حصلت عليه بموقع اجنبي وتم اعطائي الكود التالي

Sub CombineWithSpace()


  Dim A As Range

  Dim Cell As Range

  Dim FirstCell As Range

  Dim I As Long


	For Each A In Selection.Areas

	  If FirstCell Is Nothing Then Set FirstCell = A.Cells(1, 1)

	  For I = 1 To A.Cells.Count

		If A.Item(I) <> FirstCell Then

		   FirstCell = FirstCell & " " & A.Item(I)

		   A.Item(I) = ""

		End If

	  Next I

	Next A


End Sub


Sub CombineWithNoSpace()


  Dim A As Range

  Dim Cell As Range

  Dim FirstCell As Range

  Dim I As Long


	For Each A In Selection.Areas

	  If FirstCell Is Nothing Then Set FirstCell = A.Cells(1, 1)

	  For I = 1 To A.Cells.Count

		If A.Item(I) <> FirstCell Then

		   FirstCell = FirstCell & A.Item(I)

		   A.Item(I) = ""

		End If

	  Next I

	Next A


End Sub

أضع الكود هنا للإفادة لي وللجميع, طبعاً يمكن تحديد اختصار للكود بعد اضافته وبالتالي سيكون لدينا كودين, واحد للدمج مع فراغ والثاني بدون فراغ.

وفقكم الله ووفقنا لما يحب ويرضى

[أبوعبد الله]

أخي العزيز أشكرك على ردك وأشكرك على الأكواد المفيدة .

تقبل تحياتي

أبو عبدالله