اذهب الي المحتوي
أوفيسنا

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


الردود الموصى بها

تفضل أخي الحبيب إبراهيم أبو ليلة

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

  • Like 1
رابط هذا التعليق
شارك

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

 

تفضل أخي الحبيب إبراهيم أبو ليلة

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

أرجو تجربة الكود التالي المعدل...


Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Address = [F6].Address Then
      For I = 8 To 10
        If IsEmpty(Range("F6")) Then Cells(I, 4) = "" Else Cells(I, 4) = I - 7
      Next
    End If
End Sub

أخوكم بن علية

رابط هذا التعليق
شارك

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

 

تفضل أخي الحبيب إبراهيم أبو ليلة

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

أرجو تجربة الكود التالي المعدل...

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Address = [F6].Address Then
      For I = 8 To 10
        If IsEmpty(Range("F6")) Then Cells(I, 4) = "" Else Cells(I, 4) = I - 7
      Next
    End If
End Sub

أخوكم بن علية

اخى بن علية

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

ولكنه للاسف لا يفى بالغرض

جرب دمج الخليه من

F6:H6

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

وذلك بعد عمل الكود

ستجد ان الخلايا مازلت بها بيانات

تقبل تحياتى

فى انتظار الرد

Book11.rar

رابط هذا التعليق
شارك

الأستاذ  ياسر

لما ضغطت الزر فتح ال vbe على السطر  Open MyFile For Output As #1  ورسالة الخطأ  كانت بالرقم 75  ولم يخرج الملف الى الـــ c  نهائيا  إلا بعد ما عملت فولدر جديد وبالشكل االلى عرضته فى مشاركتى السابقه .

رابط هذا التعليق
شارك

أين أنت يا  ( كن ذا :power: تصل الى :jump: )

 

من المغربيه وانا فى حاله من  :eek2:

والآن  أشعر بـ :angry: 

لدرجة أنى عايز :wallbash: 

اوعى حضرتك تكون :wub:    

  ألف مليون :fff:

عايز أعرف  :Rules:  بتاع اللغز ونقولك :signthankspin:

  • Like 2
رابط هذا التعليق
شارك

الأخ الحبيب مختار ..أعتذر عن التأخر في الرد ، وبصراحة لا أعرف سبب الخطأ الذي يظهر معك .. الكود يعمل بشكل جيد معي .. :yes:

عموماً طالما أن تغيير المجلد قد عالج الخطأ فلا بأس :wink2: .. وقد انتهى العمل على اللغز بتغيير كلمة Write إلى كلمة Print فقط ..(وهذا حل اللغز) :power:

 

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

الأخ إبراهيم أبو ليلة حبيبي بوركت على مشاركاتك في الموضوع وإثراء الموضوع

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

لكن لغزك مش بسيط زي ما قلت دا لغز موضوع مش لغز تسالي ..عموما تفضل الحل في المرفق ، وبلاش تقول على اللغز بسيط ومش أد المقام ، بلاش تواضع :rol:

 

Football Matches Hossam.rar

  • Like 1
رابط هذا التعليق
شارك

Private Sub Worksheet_selectionChange(ByVal Target As Range)
Dim myrange As Range
 If Not Intersect(Target, Range("f6")) Is Nothing Then Exit Sub
 Set myrange = Union(Cells(8, 4), Cells(9, 4), Cells(10, 4))
If [f6] <> "" And Range("f6:g6").MergeCells = True Then
    Cells(8, 4) = 1
    Cells(9, 4) = 2
    Cells(10, 4) = 3
    Exit Sub
Else
    myrange = ""
End If
End Sub

 اكتب هذا الكود 

جربه أولاً في صفحة مستقلة لنعرف النتيجة

رابط هذا التعليق
شارك

أخي الحبيب سليم ..أعتذر كنت مريض ولم أنتبه جيداً للكود الرائع الخاص بالأخ الغالي حسام ..

أعتذر لكما عن عدم انتباهي لهذا الكود التحفة الروعة

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

رابط هذا التعليق
شارك

لي رجاء إخوتي ... الموضوع تحول من موضوع ترفيهي في الأساس إلى موضوع دسم ...

على رأي حسام أصبح حلبة مصارعة للمحترفين :yes: 

يرجى وضع ألغاز خفيفة فكرتها بسيطة ..

يرجى وضع ألغاز خفيفة فكرتها بسيطة ..

يرجى وضع ألغاز خفيفة فكرتها بسيطة ..

تم تعديل بواسطه YasserKhalil
رابط هذا التعليق
شارك

اخي ياسر

انت اطلب فقط و علينا التّنفيذ

لغز اخر من الجداول المتحركة 

الله يخليك انت ما تحركش عن الكرسي بتاعك عشانك مريض

جدول متحرك 1.rar

رابط هذا التعليق
شارك

أخي الغالي سليم ..الحل موجود في المرفق (نشكرك على المساعدة)

هذه هي المعادلة التي تؤدي الغرض

=IF(OR(ROWS($A$1:A1)>$I$2,COLUMNS($A$1:A1)>$J$2),"",IF(MOD(COLUMN(),2)=1,(COLUMNS($A$1:B1)-1)/2,ROW(A1)))
رابط هذا التعليق
شارك

أخي الحبيب سليم ...أعتقد أن هذه المعادلة في التنسيق الشرطي تفي بالغرض

=AND(B4<>B3,B4<B5)
تم تعديل بواسطه YasserKhalil
رابط هذا التعليق
شارك

استاذى الغالى

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

والله المشاركه دى بس لخاطر عيونك

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

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

الباسورد للشيتات 111

جدول متحرك.zip

رابط هذا التعليق
شارك

أيها الصقر الجريح ..ملف في منتهى الروعة مستر صريح قصدي جريح

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

أقصد مثلا أسماء الإجراءات الفرعية كلها حسام حساام حسااام ..هههه خلي الاسم معبر عن الهدف من الكود كما تعلمنا من حلقات عبد التواب

وأشكرك على حسن تعاونك معنا يا صقر المنتدى

رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information