تذكرة

[ahmedalyalshahat]

بسم الله الرحمن الرحيم 

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

اطلب المساعدة فى هذه التذكرة المرفقه

المطلوب

فى عمود اسمه عدد وجمبه عمود اسمة المجموع 

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

يعنى اكتب 3 يظهر فى خانه المجموع 3

بعدها اكتب 4 يظهر فى خانه المجموع 7

بعدها اكتب 3 يظهر فى خانه المجموع 10 

المهم فى خانه العدد عاملة زى الاله الحاسبة بتجمع والتجميع بتاعها يروح لخانه المجموع 

وياريت يبقى فى زر تصفير الارقام بس اللى هما الخانات

b.c.d.f.g.h.j.k.l.m.o.p 

والخانات التى تتم تثبيتها فى وقت التصفير 

هى 

a.e.i.m

وجزاكم الله خيرا 

 

تذكرة.rar

[ابو عبدالبارى]

الأخ الكريم احمد ديدو

السلام عليكم

جرب المرفق اللتالى لعلة يفى بالغرض نسألكم الدعاء

abo_abary_تذكرة.rar

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

جرب هذا الكود

Private Sub Worksheet_Change(ByVal Target As Range)
Dim RB, RF, RJ, RN, My_rg As Range
Dim My_sh As Worksheet
Dim Oldval, Newval As Long

    Set My_sh = Sheets("ورقة1")
    Set RB = Range("b6:b36"): Set RF = Range("f6:f36")
    Set RJ = Range("j6:j36"): Set RN = Range("n6:n36")
    Set My_rg = Union(RB, RF, RJ, RN)
    
If Not Intersect(Target, My_rg) Is Nothing And Target.Count = 1 Then
   With Application
        .EnableEvents = False
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
     End With
Newval = Target.Value
Application.Undo
Oldval = Target.Value
Target.Value = Newval
Target.Offset(0, 2) = Target.Offset(0, 2) + Newval
End If
        With Application
            .EnableEvents = True
            .ScreenUpdating = True
            .Calculation = xlCalculationAutomatic
         End With

End Sub

 

[ahmedalyalshahat]

1 hour ago, ابو عبدالبارى said:

الأخ الكريم احمد ديدو

السلام عليكم

جرب المرفق اللتالى لعلة يفى بالغرض نسألكم الدعاء

abo_abary_تذكرة.rar

لا انا عاوز العامود

B

يبقى كأنك فاتح الة حاسبة 

يعنى اكتب الرقم ويتجمع لوحدة على العامود 

C

يطلع الناتج ولو حبيت ازود على العمود بى يزيد على السى وازود بى يزيد سى 

 

33 minutes ago, سليم حاصبيا said:

جرب هذا الكود

Private Sub Worksheet_Change(ByVal Target As Range)
Dim RB, RF, RJ, RN, My_rg As Range
Dim My_sh As Worksheet
Dim Oldval, Newval As Long

    Set My_sh = Sheets("ورقة1")
    Set RB = Range("b6:b36"): Set RF = Range("f6:f36")
    Set RJ = Range("j6:j36"): Set RN = Range("n6:n36")
    Set My_rg = Union(RB, RF, RJ, RN)
    
If Not Intersect(Target, My_rg) Is Nothing And Target.Count = 1 Then
   With Application
        .EnableEvents = False
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
     End With
Newval = Target.Value
Application.Undo
Oldval = Target.Value
Target.Value = Newval
Target.Offset(0, 2) = Target.Offset(0, 2) + Newval
End If
        With Application
            .EnableEvents = True
            .ScreenUpdating = True
            .Calculation = xlCalculationAutomatic
         End With

End Sub

 

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

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

بعد وضع الكود

لا تفعل شيئاً فقط غير اي رقم في اي عامود B,F,j او N 

عند الضغط على الخلية A1 يتم تصفير كل شيء (ماكرو الاخ ابو عبد الباري) 

و عند تغيير اي خلية في الاعمدة(B,F,j او N ) ابتداء من الصف السادس الى 36 يتم الجمع الى الخلية المجاورة

جرب هذا المرفق

 

tazkara.rar

[ahmedalyalshahat]

لايفعل شئ انا عملت مديول جديد ووضعت فيه الكود 

وعملت حفظ وقفلت الملف وفتحته تانى 

بس لم يتغير شئ

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

1 دقيقه مضت, احمد ديدو said:

لايفعل شئ انا عملت مديول جديد ووضعت فيه الكود 

وعملت حفظ وقفلت الملف وفتحته تانى 

بس لم يتغير شئ

شاهد المرفق

عند الضغط على الخلية A1 يتم تصفير كل شيء (ماكرو الاخ ابو عبد الباري) 

و عند تغيير اي خلية في الاعمدة(B,F,j او N ) ابتداء من الصف السادس الى 36 يتم الجمع الى الخلية المجاورة

 

tazkara.rar

5 دقائق مضت, احمد ديدو said:

لايفعل شئ انا عملت مديول جديد ووضعت فيه الكود 

وعملت حفظ وقفلت الملف وفتحته تانى 

بس لم يتغير شئ

الكود(اقصد هذا الكود تحديداً) لا يوضع في مديول جديد بل في حدث الصفحة

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

أخي الكريم أحمد ديدو

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

الرابط من هنا

[ahmedalyalshahat]

1 hour ago, سليم حاصبيا said:

شاهد المرفق

عند الضغط على الخلية A1 يتم تصفير كل شيء (ماكرو الاخ ابو عبد الباري) 

و عند تغيير اي خلية في الاعمدة(B,F,j او N ) ابتداء من الصف السادس الى 36 يتم الجمع الى الخلية المجاورة

 

tazkara.rar

الكود(اقصد هذا الكود تحديداً) لا يوضع في مديول جديد بل في حدث الصفحة

اللهم صلى على النبى هو دا بالظبط

معلش عاوز اعرف عملته ازاى  

بس التصفير عاوزة على الكل ما عدا الاصناف

جزاك الله خيرا 

24 minutes ago, ياسر خليل أبو البراء said:

أخي الكريم أحمد ديدو

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

الرابط من هنا

 حبيب قلبى ياسر باشا كبيرنا 

حاليا انا فاتح الرابط وبتعلم يا كبيرنا 

طب هيا ورقه العمل دى فين 

تم تعديل سبتمبر 9, 2016 بواسطه احمد ديدو

[ahmedalyalshahat]

24 minutes ago, ياسر خليل أبو البراء said:

أخي الكريم أحمد ديدو

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

الرابط من هنا

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

كده تمام وصلت 

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

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

أكيد ينفع .. كل شيء إن شاء الله متاح

وضح التفاصيل لإخوانك وإن شاء الله يساعدوك ... ولا تنسى أن تتحدث بلغة الإكسيل (دعك من الكلام والشرح بشكل عام)

ارفق ملف بسيط (لا يشترط الملف الأصلي) ملف بسيط فيه بيانات النطاق المطلوب العمل عليه ، مع شكل النتائج المتوقعة .. وهذه الطريقة مجدية جداً وتكون أسرع في الوصول للمطلوب .. اتبع أسلوب البساطة وستجد بدلاً من الحل الواحد أكثر من حل

تقبل تحياتي

[ahmedalyalshahat]

3 hours ago, ابو عبدالبارى said:

الأخ الكريم احمد ديدو

السلام عليكم

جرب المرفق اللتالى لعلة يفى بالغرض نسألكم الدعاء

abo_abary_تذكرة.rar

 

2 hours ago, سليم حاصبيا said:

جرب هذا الكود

Private Sub Worksheet_Change(ByVal Target As Range)
Dim RB, RF, RJ, RN, My_rg As Range
Dim My_sh As Worksheet
Dim Oldval, Newval As Long

    Set My_sh = Sheets("ورقة1")
    Set RB = Range("b6:b36"): Set RF = Range("f6:f36")
    Set RJ = Range("j6:j36"): Set RN = Range("n6:n36")
    Set My_rg = Union(RB, RF, RJ, RN)
    
If Not Intersect(Target, My_rg) Is Nothing And Target.Count = 1 Then
   With Application
        .EnableEvents = False
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
     End With
Newval = Target.Value
Application.Undo
Oldval = Target.Value
Target.Value = Newval
Target.Offset(0, 2) = Target.Offset(0, 2) + Newval
End If
        With Application
            .EnableEvents = True
            .ScreenUpdating = True
            .Calculation = xlCalculationAutomatic
         End With

End Sub

 

تمام كله زى الفل بس دلوقتى 

اعمل الزرار بتاع التصفير ازاى وعاوزه يكون على 

c.b.d

 يصفرهم لما اضغط علية 

 

[ahmedalyalshahat]

صفير لو سمحتم بيتعمل ازاى 

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

1 دقيقه مضت, احمد ديدو said:

صفير لو سمحتم بيتعمل ازاى 

هو ايه اللي بيتعمل إزاي ؟؟ وضح المطلوب بشيء من الدقة (ومتقرهاش الدقة لأني دي معناها الشطة .. شكلي كدا هجيبلك معايا شطة وأنا جاي بعد أجازة العيد)

[ahmedalyalshahat]

التصفير بس الت اتمسحت

الزرار بتاع التصفير

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

 

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

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

[ahmedalyalshahat]

توصل بالسلامه يا غالى ربنا معاك 

28 minutes ago, ياسر خليل أبو البراء said:

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

 

يا شباب الرسله دى بتيجى لما بحفظ الملف لية 

وعاوز اخليها متجيش

 

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

ما هو إنت لو كنت بتسمع الكلام وتشوف الروابط اللي بعطيها لك كنت عرفت حل المشكلة دي من غير ما تسأل ..

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

راجع الموضوع وستجد الحل نصب عينيك

الرابط من هنا