ألغاز إكسيلية (موضوع ترفيهي)

[ياسر خليل أبو البراء]

أخي الحبيب سليم

بلاش الألغاز الصعبة دي ..عايزين حاجة سهلة كدا على أد مستوانا ..

عموما شوف دا ينفع (مش عاجبني بس أهو حاجة نتقدم بيها عشان الصقر مياكلش وشي)

Merge UnMerge.rar

[شوقي ربيع]

السلام عليكم

هذا حل بخصوص دمج الخلايا و الغاء الدمج مهوش بعيد عن حل الاخ ياسر يشبهلو تقريبا مع شوية تغيرات

Sub MergeCells()
Dim wSh As Worksheet: Set wSh = ActiveSheet
Dim lLrw     As Long:  lLrw = wSh.Cells(wSh.Rows.Count, 1).End(xlUp).Row
Dim iI  As Integer
    Application.DisplayAlerts = False
For iI = 2 To lLrw
If wSh.Range("A" & iI - 1) = wSh.Range("A" & iI) Then wSh.Range("A" & iI - 1 & ":A" & iI).Merge
Next
    Application.DisplayAlerts = True
End Sub

Sub UnMergeCells()
Dim wSh As Worksheet: Set wSh = ActiveSheet
Dim lLrw     As Long:  lLrw = wSh.Cells(wSh.Rows.Count, 1).End(xlUp).Row
Dim iI  As Integer
    Application.DisplayAlerts = False
For iI = 1 To lLrw
If wSh.Range("A" & iI).MergeCells Then wSh.Range("A" & iI).UnMerge: wSh.Range("A" & iI + 1) = wSh.Range("A" & iI)
Next
    Application.DisplayAlerts = True
End Sub

[سليم حاصبيا]

 اخي ياسر الكود يعمل جيداً

لكن ينقصه حاجة

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

هل تريد ان ارسل الكود الذي كتبته انا او لسه بدري شوية

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

عدل هذا السطر هكذا

For iI = lLrw To 2 Step -1

[ياسر خليل أبو البراء]

نورت الموضوع أستاذي الكبير عبد الله باقشير

مشكور على تشريفك للموضوع .. ويا ريت متحرمناش من لغز (بس يكون على أد مستوانا .. )

 

الأخ سليم تفضل المرفق التالي فيه ما تريد

تقبلوا تحياتي

Merge UnMerge YK.rar

[سليم حاصبيا]

 اخي ياسر

كود جميل 

وحان الوقت كي اكشف انا عن الكود يتاعي

merge unmerge.rar

[ياسر خليل أبو البراء]

الله الله على الجمال والروعة ..

بسم الله ما شاء الله تبارك الله ..

ملف في منتهى الروعة والإبداع

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

 

بس لي رجاء بالله عليك بلاش الألغاز الدسمة دي .. عايزين ألغاز خفيفة عشان الناس كلها تشارك ..لغز بس يكون فيه خدعة (بالعامية كدا يكون فيه تركاااااااااية يعني خدعة ..حاجة تبقا تايهة عن الناس)

 

تقبل تحياتي وتقديري واحترامي وحبي وأشواقي

[ياسر خليل أبو البراء]

بعد إذن العمالقة .. (هذا اللغز للمبتدئين فقط)

اختصر الكود التالي في سطر واحد

Sheet1.Range("A1:A20").Copy
Sheet1.Range("B1").PasteSpecial
Application.CutCopyMode = False   

ممنوع الإجابة من الأعضاء المميزين أو الخبراء أو المشرفين ..هذا اللغز للمبتدئين في عالم البرمجة

الكود يقوم بنسخ النطاق A1:A20 إلى الخلية B1 كأول خلية يتم لصق البيانات بها ، ثم يتم إلغاء خاصية النسخ واللصق ..أي مسح الحافظة Clipboard

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

Sheet1.Range("A1:A20").Copy: Sheet1.Range("B1").PasteSpecial: Application.CutCopyMode = False

هذا غير مسموح به ..غير مسموح استخدام علامة :

 

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

تم تعديل ديسمبر 25, 2014 بواسطه YasserKhalil

[سليم حاصبيا]

اخي ياسر

عندي حل لكن انا انتظر بعض الوقت لارى ماذا يفعل الاخوة الباقيين

[ياسر خليل أبو البراء]

كفاية شغل محترفين يا أخ سليم

أنا متأكد إن عندك الحل ، وممكن يكون حل أفضل من الحل اللي عندي كمان...

بس ندي فرصة للأعضاء يشاركوا     ..عشان ميكونش الموضوع مقتصر على بعض الأعضاء دون الكل

تقبل تحياتي أخي وحبيبي في الله سليم

[جلال الجمال_ابو أدهم]

استاذ / ياسر خليل
و اساتذتى الذين تفاعلوا مع الموضوع
 
بارك الله فيكم
اسجل اعجابى بتنوع الافكار و الابداعات

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

تحياتى و كل عام و انتم بخير

[ياسر خليل أبو البراء]

مشكور على مرورك العطر أخي جلال

بس إنت داخل الموضوع وايدك فاضية (المرة الجاية تجيب معاك لغز ومتدخلش فاضي علينا)

نورت الموضوع بمشاركتك وكلامك الطيب

تقبل تحياتي

[ياسر خليل أبو البراء]

إخواني المبتدئين يبدو أن الألغاز لا تروقهم

عموماً ..نترك لغز المبتدئين ، ونطرح لغز للمتقدمين قليلاً ...

اللغز مطلوب حله في سطر واحد فقط

مطلوب تحديد النطاق A1:D10 (مش دا المطلوب يا عمالقة ..المطلوب إن يكون عدد الصفوف ديناميكي وعدد الأعمدة ديناميكي يعني من الآخر سطر واحد تقدر من خلاله تحدد أي مدى من النطاق بداية من A1 كبداية فقط أما النهاية فغير معلومة )))

ممنوع استخدام الـ Name Manager .. ممنوع استخدام علامة : للفصل بين الأسطر في سطر واحد

سطر واحد فقط يفي بالغرض ..

في انتظار الهمة

تم تعديل ديسمبر 25, 2014 بواسطه YasserKhalil

[عبد المنعم]

ما رأيك ؟
 

initialRw = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
initialClm = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column

Range(Cells(1, 1), Cells(initialRw, initialClm))

[ياسر خليل أبو البراء]

جزيت خيراً أخي عبد المنعم

ممكن نختصر كود في سطرواحد :

Range(Cells(1, 1), Cells(ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row, ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column)).Select

بس بردو مش دا المطلوب .. فيه سطر مختصر عن كدا

[عبد المنعم]

طيب نخليها كده على شانك   
 

Range("A1", ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell)).Select

[ياسر خليل أبو البراء]

الله ينور يا أخ عبد المنعم

تمام ..دا المطلوب ، وفي انتظار إجابات أخرى لنفس اللغز

[سليم حاصبيا]

 اخي ياسر

ما رأيك بهذا الكود

Sub last_cel()
Range(Cells(1, 1), Cells(UsedRange.Rows.Count, UsedRange.Columns.Count)).Select
End Sub

[ياسر خليل أبو البراء]

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

يا منور الموضوع بشكل دائم غير منقطع

الكود أعطاني خطأ .. مش عارف إذا كان الخطأ بيظهر عند الكل ولا لا ..لأنك أكيد جربت الكود :

عموما لما جربته بالشكل ده اشتغل تمام

Range(Cells(1, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count)).Select

تقبل تحياتي

[سليم حاصبيا]

عندي لم يحصل اي خطأ

ربمل وضعت الكود في module  مستقل و اذا كان هناك صفحات اخرى في المصنف تحتوي على بيانات ،فأن اكسل لا يعرف الى اي صفحة يتجه

ربما  كان هذا السبب والله أعلم.

[ياسر خليل أبو البراء]

أخي الغالي سليم

أنا عادة لا أعمل إلا مع ورقة عمل واحدة فقط

الخطأ سببه عدم إحساسه بالكائن Activesheet .. ولا أعرف السبب في أن يعمل لديك ولا يعمل لدي .. أنا أعمل على نسخة أوفيس 2007 ... قد تكون النسخ مختلفة !!

[سليم حاصبيا]

على العموم

اضافة جيدة لمن عندهم هذا الاوفيس

[سليم حاصبيا]

 لغز جديد دسم حبتين للمتقدمين فقط

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

[ياسر خليل أبو البراء]

فين الجدول ؟ يبدو أن إرفاق الملفات لا يعمل ..

جربت من شوية إرفاق ملف ولم يعمل معي ...

وبعدين ايه حكايتك مع الجداول المتحركة ..أنا حاسس إن الموضوع بقا في بحر الرمال العظيم

[سليم حاصبيا]

ارفاق الملفات لا يعمل و تظهر رسالة في اسفل الصفحة (الرد على مشاركة مقتبسة ) و جانبها "مسح"

لا اعرف ما هذا صراحة