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

[بن علية حاجي]

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

لغز اعجبني لفتح ملف اكسل في بعض المواقع

1- الرقم الخامس + الرقم الثالث = 14
2- الرقم الرابع اكثر بواحد من الرقم الثاني
3- الرقم الأول اقل بواحد من ضعف الرقم الثاني
4- الرقم الثاني + الرقم الثالث = 10
5- مجموع الأرقام الخمسة = 30

ماهي الأرقام الخمسه .. بالترتيب طبعا .. الأرقام هي نفسها الشفره اللي راح تفك ملف الأكسل

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

 

الشرط الأول يعطي : z + u = 14

الشرط الثاني يعطي : t = y + 1

الشرط الثالث يعطي : x = 2 y - 1

الشرط الرابع يعطي : y + z = 10

الشرط الخامس يعطي : x + y + z + t + u = 30

 

ومن الشروط (الأول و الثاني و الخامس) نجد : x + 2 y = 15       ومن هذه النتيجة والشرط الثالث نجد :   y = 4

 

وبالتعويض في المعادلات المناسبة نجد أن : x = 7 ، z = 6 ، t = 5 ، u = 8

وبالتالي العدد المطلوب هو : 74658

 

والله أعلم

تم تعديل ديسمبر 21, 2014 بواسطه بن علية حاجي

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

 السلام عليكم

استاذ بن علية 

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

حل الرقم السري للاخ ابو صلاح

الرقم السري-ابو صلاح.rar

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

اخي بن علية

تعديل بسيط على المعادلة لتعمل اينما وضعتها سواء في   B4  او في اي مكان اخر

=IF(AND(ROWs($A1:a1)<=$J$2;COLUMN($A$1:a1)<=$K$2);$K$2*(ROWs($A$1:a1)-1)+COLOMNs($A$1:a1);"")

تحياتي

[بن علية حاجي]

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

اخي بن علية

تعديل بسيط على المعادلة لتعمل اينما وضعتها سواء في   B4  او في اي مكان اخر

=IF(AND(ROWs($A1:a1)<=$J$2;COLUMN($A$1:a1)<=$K$2);$K$2*(ROWs($A$1:a1)-1)+COLUMNs($A$1:a1);"")

تحياتي

أخي الكريم سليم، أولا أشكرك جزيل الشكر على تذكيرك لي لطريقة حل مسألة الكود (حل جمل المعادلات من الدرجة الأولى) باستعمال دوال المصفوفات وهي طريقة ندرّسها في صفوف الثانوي... المهم شكرا على هذا العمل الجميل... بالنسبة لتعديلك للمعادلة فهذا التعديل فيه بعض الأخطاء، وقد استعملت في معادلتي (المختصرة) الدالتين ROW و  COLUMN بدلا من الدالتين ROWS و  COLUMNS.... والمعادلة التي وضعتها في ردي السابق يمكن حجزها في أي موضع كان غير الخلية  B4...

 

شكرا على الفائدة

 

أخوك بن علية

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

اخي بن علية 

انا لم أقم بتجربة المعادلة 

فقط القيت نظرة عليها و اقترحت التعديل من باب التطوير ليس الا

[بن علية حاجي]

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

اخي بن علية 

انا لم أقم بتجربة المعادلة 

فقط القيت نظرة عليها و اقترحت التعديل من باب التطوير ليس الا

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

=IF(AND(ROWS($A$1:$A1)<=$J$2;COLUMNS($A$1:A$1)<=$K$2);$K$2*(ROWS($A$1:$A1)-1)+COLUMNS($A$1:A$1);"") 

أخوك بن علية

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

جزاك الله خيراً اخي بن علية

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

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

إلى الغير متابعين للموضوع من بدايته ...

حل اللغز الأول مجمع في ملف واحد (الخاص بعد الخلايا في ورقة العمل)

Count Cells.rar

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

وإليكم حل اللغز الخاص بملء الفراغات في نطاق محدد بكلمة Blank

 مجمع كل الحلول في ملف واحد أيضاً

Fill Blanks.rar

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

وإليكم حل اللغز الخاص بالأخ سليم الجدول المتحرك (بيفكرني ببحر الرمال المتحرك)

والحلول مجمعة في ملف واحد

Movable Table Conditional Formatting.rar

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

وإليكم أيضاً - عشان الناس اللي بتقول إني ناااااايم - حل اللغز الخاص بالأخ سليم (الأرقام التي يتم قسمتها على 2 و 3 و 4 و 5 و 6 ) ويتبقى واحد

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

Remainder One.rar

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

لغز جديد

إليكم إخواني لغز جديد .. في الملف المرفق يوجد كود يقوم بإنشاء ملف نصي إن لم يكن موجود ، في المسار C

قم أولاً بتحديد النطاق من A1:D5 ثم قم بالضغط على زر RUN لتنفيذ الأمر    ....

إذا قمت بالإطلاع على الملف النصي في البارتشن C ستجد أقواس تنصيص وفواصل ..

كيف يمكن التخلص من هذه الفواصل وأقواس التنصيص .. بالتعديل على الكود الموجود؟

Write Data To Text File.rar

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

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

اخي ياسر 

بارك الله بك و بهذا العمل الرائع (تجميع الحلول للالغاز)

لكن نسيت الظاهر لغز الاخ ابو صلاح في المشاركة 46 من هذا الموضوع

تم التوصل الى حلين احدهما بواسطة معادلات الاكسل (مشاركتي انا رقم 52)

والثانية تعتمد على معادلات رياضية(رقم 51)

ارجو الاطلاع

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

الاخ الحبيب سليم هل تظنني قد نسيت ؟!! كنت فقط أجهز الملف فحسب .. وعذراً قمت باقتبااس حلك مع بعض التعديلات ليفهمه الأعضاء

MMULT.rar

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

[ابو تراب]

بعد اذا اخي سليم

 

اخي ياسر هذه محاولة

 

ممكن استخدام Print بدلا عن Write

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

الأخ الحبيب أبو تراب تسلم يا كبير على الحل الأمثل من أول ضربة

.........

جزيت خيراً ..وفي انتظار لغز جديد منك إن شاء الله

[مختار حسين محمود]

أستاذ ياسر السلام عليكم

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

ملحوظة قبل الحل :

فى الكود الأصلى حصل خطأ فى السطر Open MyFile For Output As #1 "تم تصحيحه بتغيير بسيط فى مسار الملف .

تفضل الكود والنتيجة :

Option Explicit

Sub WriteDataToTextFile()
   Dim MyFile As String, Rng As Range, CellValue As Variant, I As Integer, J As Integer
   ' أضف هذا السطر
    Dim stEncoding As String, stSeparator As String
    
  Set Rng = Selection
  '  أستاذ ياسر فيه خطأ عندك فى كودك فى السطر التالى
  ' MyFile = "C:\Test.txt"
  ' والتعديل يصبح كالتالى
 MyFile = "C:\MyDocuments\Test.txt"
  'لإزالة الفواصل والرموز  أضف السطرين التاليين
  stSeparator = vbTab
  stEncoding = "UTF-8"
    
   Open MyFile For Output As #1
   
    For I = 1 To Rng.Rows.Count
        For J = 1 To Rng.Columns.Count
            CellValue = Rng.Cells(I, J).Value
           If J = Rng.Columns.Count Then
                Write #1, CellValue
            Else
                Write #1, CellValue,
            End If
        Next J
    Next I
                
    Close #1
End Sub

لاحظ أنه تم إنشاء فولدر باسم MyDocuments  فى الـــــــــ c  يتم استخراج الملف    Test.txt فيه

والنتيجة كانت كالتالى

 

"Col-A","Col-B","Col-C","Col-D"
"Yasser","Ahmed","Reda","Hany"
"Gamal","Rabab","Shahd","Fahd"
"Baraa","Mariam","Nour","Salah"
"Yasin","Hussein","Laila","Salim"
والسلام عليكم

وانتظر منى لغز جميل

وبلاش :wink2:

تم تعديل ديسمبر 22, 2014 بواسطه مختار حسين محمود

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

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

ثم إن التغيير الذي أجريته لم يغير مجريات الأمور ، وكانت النتيجة كما هي ، أقواس التنصيص كما هي ، والفواصل كما هي ..تقبل تحياتي وبلاش

[الصـقر]

استاذى ومعلمى وحبيبى

سليم بك حاصبيا 

ملك المعادلات

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

ولكن بعد دعوتك خجلت من نفسى وكان لازم البى الدعوه -( فقم للمعلم ووفه التبديلا كاد المعلم ان يكون رسولا)

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

اتمنى ان يحوز اعجابك

Sub ÌÏæá()
ActiveSheet.Unprotect Password:="111"
If [j2] = "" Or [k2] = "" Or [l2] = "" Then MsgBox "فضلا قم بتحديد عدد الصفوف والاعمده وبداية تسلسل الجدول": Exit Sub
Application.ScreenUpdating = False
Range("a3:zz100000").ClearContents
[a3] = [l2]
   Lr = Range("j2").Value
   Ll = Range("K2").Value

   For i = 4 To Lr + 2
   For o = 2 To Ll
                Cells(3, o).Value = "=RC[-1]+r2c10"
                Cells(i, 1).Value = "=R[-1]C+1"
                Cells(i, o).Value = "=R[-1]C+1"
Next
Next
ActiveSheet.Protect Password:="111", DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub

جدول متحرك.zip

[الصـقر]

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

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

بارك الله فيك أخ حسام على الكود الرائع ...

تسلم الأيادي .. ولا تحرمنا من تواجدك معنا بالموضوع ، وإضافة لغز إذا أمكن (هو كله على دماغي !!! ارحمني أنا مريض)

[الصـقر]

لغز جديد اهو يا كبير مش حارمك من شئ يا عم ياسر

هو لغز صغير مش قد المقام 

المطلوب داخل المرفق 

طبعا الملف لمحبى وعشاق كرة القدم 

مباريات 1.zip

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

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

[الصـقر]

بطل حجج شوية تعبان وشوية ملكش بالكورة يالا لف التراك 100 مرة هههههههههههههههههههه

[إبراهيم ابوليله]

 

 السلام عليكم 

رداً على سؤال الاستاذ ابراهيم ابو ليلى

  وضع كلمة "Blank"  حتى في الخلايا المدمجة

اخى سليم بالفعل

الكود يعمل بنجاج

مشكورا عليه

ولكن لدى كود وهو

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Address = [F6].Address Then
H
End If
End Sub
Sub H()
On Error Resume Next
Cells(8, 4) = 1
Cells(9, 4) = 2
Cells(10, 4) = 3
End Sub

اريد مسح الخلايا وجعلها فارغه

فى حالة فراغ الخليه F6