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

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

قام بنشر

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

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
قام بنشر

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

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

=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)))
قام بنشر

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

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

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

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

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

الباسورد للشيتات 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