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

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

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

إخواني الأحباب

أقدم لكم اليوم موضوع ليس بموضوع .. لا فائدة منه ، وفيه فائدة من ناحية أخرى ..

أعشق التناقض كما ترون    (لأن التناقض يظهر المعنى ويوضحه ويبرزه)

الموضوع ليس موضوع أي أنه لا يمكن أن يتمحور في نقطة واحدة ، إنما هو Open أي موضوع مفتوح للجميع ، وللجميع أن يشارك ويتفاعل ، ويطرح ألغاز يقوم الجميع بحلها.

الموضوع فيه فائدة ، وهو الاستفادة من إمكانيات البرنامج عن طريق إظهار الحيل والتي تسمى باللغة الإنجليزية Tricks ، ومن ثم ففيه فائدة ..

ببساطة ممكن نقول على الموضوع إنه هيكون : معلومة في شكل ترفيهي (معلومة TakeAway .. زي الوجبات التيك أواي) ، يعني خد المعلومة واجري ...

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

     

اللغز الأول :::

ما هو عدد خلايا ورقة العمل في أوفيس 2007 أو 2010 أو 2013 ؟

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

[محمد الريفى]

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

هجاوب نص نص على ادى

اصدار 2003 فيه خلايا عددها 16 مليون و 777 الف و 216

لان عدد الصفوف 65536 صف وعدد الاعمده 256 . ولو ضربنا الاعمده X الصفوف = الخلايا

اصدار 2007 و2010 فيه خلايا عددها

             17,769,693,184

لان عدد الصفوف 1048576 صف وعدد الاعمده 16384 . ولو ضربنا الاعمده X الصفوف = الخلايا

  مقولتش يااستاذنا ايه الجايزه

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

الأخ محمد الريفي

بارك الله فيك وجزاك الله خير الجزاء ، ومتزعلش من اللي جاي!!

الملحوظة الأولى : اللغز لم يتضمن السؤال عن الإصدار 2003 (لازم الدقة في الإجابة)

الملحوظة الثانية :

الإجابة صحيحة والطريقة خاطئة ..

إجاباباتك صحيحة بنسبة 100% ولكن ...

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

بس تسلم على المشاركة الفعالة

عايزين الناتج يكون في الخلية A1

[محمد الريفى]

ايه رايك انتظر حد غيرى يجاوب يااستاذنا

[ibn_egypt]

 

إجاباباتك صحيحة بنسبة 100% ولكن ...

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

 

 

طريقة حلى .. طبعا بالأكواد

 

حددت الشيت كامل وسميته وليكن data كنطاق واحد 

 

ودخلت محرر الأكواد وفي حدث Worksheet_Activate

 

كتبت السطر ده

Range("A1").ClearContents
Range("A1") = Application.CountBlank(Range("data"))

اعطانى الرقم 17179869184 في الخلية A1 >>> اعتقد انه صحيح ... اوفيس 2010

 

بس .. شكرا

 

الى اللقاء في لغز آخر

 

تحياتي  

[شوقي ربيع]

السلام عليكم

حلو الموضوع

هذا كود يعطيك عدد الخلايا في لاي اصدار

Sub Test()
Dim wSh As Worksheet: Set wSh = ActiveSheet
Dim lRrw As Long: lRrw = wSh.Rows.Count
Dim lClm As Long: lClm = wSh.Columns.Count
Dim dNRng As Double: dNRng = Val(lRrw) * Val(lClm)
MsgBox "عدد الخلايا هو " & dNRng
End Sub

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

بسم الله ما شاء الله ..الموضوع شكله هيطلع الإبداع اللي عند الناس كلها...

الأخ الحبيب ابن مصر المبدع دائماً بارك الله فيك

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

نقطة مهمة بالنسبة لإخوانا المتابعين لحلقات افتح الباب

Dim dNRng As Double

استخدم الأخ شوقي المتغير Long في الإعلان عن المتغير الخاص بعد الأعمدة ، والمتغير الخاص بعد الصفوف ..أما المتغير dNRng فأعلن عنه من النوع Double حيث أن عدد الخلايا في ورقة العمل يتعدى حدود النوع Long ..

جميل جداً إخواني ، وما زلت في انتظار حلول أخرى

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

[محمد الريفى]

فهمت يااستاذنا انت عاوز حل ازاى

ولكن بعد اجابات اساتذة ال VBA والاكسيل

اليك اجابة بالمعادلات

خد هذه من العبد لله . وطبقها  . ستاتى بالنتيجة ان شاء الله

=ROWS(A:A)*COLUMNS(1:1)

New ورقة عمل Microsoft Excel.rar

[شوقي ربيع]

للافادة كما قال اخي ياسر

هذا الكود يعطيك الاصدار و عدد الصفوف وعدد الاعمدة وعدد الخليا

Sub Test()
Dim wSh As Worksheet: Set wSh = ActiveSheet
Dim lRrw As Long: lRrw = wSh.Rows.Count
Dim lClm As Long: lClm = wSh.Columns.Count
Dim dNRng As Double: dNRng = Val(lRrw) * Val(lClm)
Dim sTex As String

Select Case Val(Application.Version)
    Case 9: sTex = "أوفيس 2000"
    Case 10: sTex = " أوفيس 2002"
    Case 11: sTex = " أوفيس 2003"
    Case 12: sTex = " اوفيس 2007"
    Case 14: sTex = " أوفيس 2010"
    Case 15: sTex = " أوفيس 2013"
End Select

MsgBox "الاصدار " & sTex & vbNewLine & _
"عدد الصفوف " & lRrw & vbNewLine & _
"عدد الاعمدة  " & lClm & vbNewLine & _
"عدد الخلايا  " & dNRng

End Sub

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

الله ينور يا أستاذ محمد تسلم الأيادي .

الأستاذ الكبير أوي شوقي ربيع

ممكن تعيد لصق الكود مرة تانية عشان اللغة العربية تظهر منضبطة

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

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

الجواب على اللغز الأول سؤال 1

احاول ان اجد طريقة لبقية الأسئلة (صبرك عليّ)

عدد الخلايا 2010.rar

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

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

بارك الله فيك ..جيت متأخر يا كبير

ممنوع الملفات المرفقة في الموضوع ، اطرح الكود أو المعادلة في المشاركة نفسها ..

قلنا الإجابة تكون في الخلية A1 وبس .. تاني حاجة تكون الفكرة غير مكررة ، وللأسف فكرتك مكررة حيث تقدم بها الأخ محمد الريفي وسبقك إليها ..

حظ أوفر في الألغاز القادمة .. تقبل تحياتي

[ابو بهاء المصري]

معلومات سهلة ولاكنها تخرج كثير من الابداع

لعمالقة يتصارعون علي زيادة خبرتنا وعلوماتنا

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

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

مشكور أخي أبو بهاء المصري

أنا بانتظار حلول أخرى (من الآخر كدا فيه حل لسه محدش جاااااااااااابه ..فكرته جديدة نوعاً ما ) .. يلا يا حبايب ورونا الإبداع في منتدى الإبداع

[شوقي ربيع]

السلام عليكم

ان كنت تبحث عن ابسط كود يفي بالغرض

هاك هدا الكود

Sub Test()
MsgBox Cells.CountLarge
End Sub

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

الأخ شوقي ربيع ..

تسلم الأيادي يا كبير .. جزيت خيراً !

هو دا الحل المثالي (الله ينور عليك) بارك الله فيك .. وجزاك الله خير الجزاء في الدنيا والآخرة

هذا هو الحل الأمثل وهو دا اللي كنت في انتظاره للاستفادة بمعلومة جديدة ، ألا وهي CountLarge وليس Count

حيث أن الخاصية Count تعطي خطأ overflow error فإذا كان النطاق المحدد أكثر من 2,147,483,647 أما الخاصية CountLarge تتعامل مع أكثر من 17,179,869,184

وبالتالي يمكن عد خلايا ورقة العمل باستخدام الخاصية CountLarge بالشكل التالي :

Range("A1").Value = FormatNumber(Cells.CountLarge, 0)

تم استخدام FormatNumber لتنسيق الرقم لإظهار فاصل الآلاف ..

 

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

 

انتهى اللغز الأول .. وفي انتظار الأخوة  بالمشاركة بلغز مفيد وجديد

Count Cells.rar

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

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

إخواني الأحباب إذا لم تكن فكرة الألغاز تعجبكم فيرجى عدم المشاركة!!

أريد تفاعل وطرح ألغاز من قبلكم ، لتنشيط عقول الأعضاء الخاملة ..

طالما إن مفيش حد طرح لغز أطرح أنا واحد تاني....

::اللغز الثاني::

في النطاق A1:B10 يوجد بعض الخلايا بها بيانات وأخرى فارغة .. ما الطريقة التي يمكن بها ملء الخلايا الفارغة بكلمة Blank مثلاً ؟؟

في انتظار حلولكم ومشاركاتكم بألغاز مفيدة وجديدة

[ibn_egypt]

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

 

انا قبل البحث كنت اعرف طريقتين ...

 

الأولى الطريقة التقليدية بدون معادلات او اكواد  ( بتحديد النطاق ثم بحث Find ثم Go to Special واختار Blanks >>> وبعدها اكتب الاسم اللى عايزه وليكن "Ibn_Egypt" واضغط Ctrl+Enter

 

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

Sub Fill_Blanks()
Application.ScreenUpdating = False
For Each cell In Range("A1:B10")
 ' Or we can type If Len(cell) = 0 Then
    If IsEmpty(cell) Then
        cell.Value = "Ibn_Egypt"
    End If
Next
Application.ScreenUpdating = True
End Sub

لكن لعلمى انك طرحت سؤال زي ده فأكيد فيه حاجة اسهل من الطريقتين دول  ... وبعد البحث لقيت السطر ده بس وبيقوم بالغرض تمام

Sub Fill_Blanks2()
Range("A1:B10").SpecialCells(xlCellTypeBlanks).Value = "Ibn_Egypt"
End Sub

تحياتي وتقديري استاذي الفاضل وجعل اللهم عملك في ميزان حسناتك

 

وإلي اللقاء في لغز آخر      

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

بسم الله ما شاء الله عليك يا ابن مصر موسوعة ...

الله ينور عليك ....بصراحة إنت عملت الواجب وزيادة !!

ننتظر حلول أخرى لعل هناك من لديه في جرابه شيئاً آخر .. تقبل تحياتي وجزيت خيراً على تشجيعك الدائم لي

[ابو تراب]

موضوع اكثر من رائع .. واستفدت من الدالة CountLarge   

 

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

 

[علي المصري]

استخدم  

=COUNTBLANK(1:1)*COUNTBLANK(A:A)

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

الأخ الحبيب أبو تراب

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

وفي انتظار مشاركاتك بألغاز من عندك .. إنت مبتكر الألغاز

 

الأخ الغالي علي المصري

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

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

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

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

الكود مرفق

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("a1:b10")) Is Nothing Then

Dim myrange As Range
Set myrange = Range("a1:b10")
i = 1
Do Until i >= 10
If Cells(i, 1) = "" Then Cells(i, 1) = "blank"
If Cells(i, 2) = "" Then Cells(i, 2) = "blank"
i = i + 1
Loop
End If

End Sub

blank.rar

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

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

بارك الله فيك ...

بالنسبة للملف المرفق في الصف رقم 10 في العمود الأول والثاني ..لم ينطبق الكود رغم الإشارة إليه ..!! بحاول يمين شمال مش قادر أجمع ايه السبب؟

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

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A1:B10")) Is Nothing Then
        If IsEmpty(Target) Then Target.Value = "Blank"
    End If
End Sub

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

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

 تسلم  (Keyboard)ـك  أقصد ايديك  اخي ياسر كود رائع أفضل من الذي عندي

على فكرة كي يعمل الصف العاشر يجب ان تزال علامة = قبل الرقم عشرة 

لتصبح do until i>10