اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

كود لتحديث القيم


إذهب إلى أفضل إجابة Solved by طارق محمود,

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

الأخوة الأكارم

 

السلام عليكم

 

لدي الكود و الذي يقوم بتحديث القيم الموجودة في العمود رقم 13 ضمن ملف الاكسل و ذلك عند فتح الملف

 

لكن يعاب على الكود عدم توقفه و يقوم باحتساب جميع قيم الخلايا في العمود 13 في الملف

 

و الذي اريد مساعدتكم به هو تعديل الكود ليقوم بتحديث القيم في العمود رقم 13 فقط عندما تكون قيمة الخلية في العمود رقم 2 اكبر من الصفر

 

و هل بالإمكان ان يتم وضع شرط لتنفيذ هذه السطور البرمجية فمثلاً ان يتم تنفيذ هذه الاوامر البرمجية حين وضع كلمة Update مثلاً في الخلية A1 بدلاً من تنفيذ الاوامر عند فتح الملف

 

و بحيث يتم التنفيذ فقط في حال كانت قيمة الخلية في العمود 2 اكبر من الصفر اما الاسطر التي يكون فيها قيمة العمود رقم 2 تساوي الصفر لا يتم تنفيذ فيها هذه الاوامر البرمجية

 

مع الشكر لكم و بارك الله فيكم
 
 

 

Private Sub Worksheet_Calculate()
 
    If Refreshing_M = True Then Exit Sub
    
    Refreshing_M = True
    Dim i As Integer
    For i = 2 To Sheet1.UsedRange.Rows.Count
        ' Just refresh the "M" cell and it will recall what needs to be recalled
        Cells(i, 13) = Cells(i, 13)
    Next i
    Refreshing_M = False
    
End Sub

 

 

 

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

  • أفضل إجابة
السلام عليكم
تفضل أخي
 

Private Sub Worksheet_Calculate()


   If Refreshing_M = True Then Exit Sub
    
    Refreshing_M = True
    LR = Sheet1.[B9999].End(xlUp).Row
    Dim i As Integer
    For i = 2 To LR
        ' Just refresh the "M" cell and it will recall what needs to be recalled
        If Cells(i, 2) = 0 Then GoTo 10
        Cells(i, 13) = Cells(i, 13)
10  Next i
    Refreshing_M = False
    
End Sub

إذا لم يعمل ، أرسل الملف كاملا

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

بارك الله فيك أستاذ طارق

 

و كتب الله مساعدتك لي في ميزان حسناتك

 

تمت التجربة و بالفعل تمت بنجاح و الحمد لله

 

لدي طلب آخر ان امكن بارك الله فيك و هو عدم تحديث القيمة في العمود  رقم 13 ضمن السطر في حال كان العمود رقم 10 توجد فيه قيمة اكبر من الصفر ( يعني انني لا اريد تحديث القيمة في حال وجود تاريخ في العمود رقم 10 بمعنى آخر استثناء السطر من التحديث الذي يحتوي تاريخ في العمود رقم 10 )

 

و هل بالإمكان ان يتم وضع شرط لتنفيذ هذه السطور البرمجية فمثلاً ان يتم تنفيذ هذه الاوامر البرمجية حين وضع كلمة Update مثلاً في الخلية A1 بدلاً من تنفيذ الاوامر عند فتح الملف ؟؟؟

 

جزاك الله كل الخير و بارك الله فيك

تحديث القيم.rar

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

السلام عليكم

تم استثناء السطر من التحديث في حالة أن العمود 10 يحتوي أرقام

وهذا هو الكود

 

 

Sub WS_Calculate()




   If Refreshing_M = True Then Exit Sub
    
    Refreshing_M = True
    LR = Sheet1.[B9999].End(xlUp).Row
    Dim i As Integer
    For i = 2 To LR
        ' Just refresh the "M" cell and it will recall what needs to be recalled
        If Cells(i, 2) = 0 Or IsNumeric(Cells(i, 10)) Then GoTo 10
        Cells(i, 13) = Cells(i, 13)
10  Next i
    Refreshing_M = False
    
End Sub

وتم تغيير الكود من حدث الصفحة ليصبح عاديا ومرتبط بالزر الأزرق بالخلية A1  فقط إضغط عليه

 

تفضل المرفق

 

تحديث القيم2.rar

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

أستاذ طارق بارك الله فيك

 

مشكور جداً لتفاعلك الرائع

 

التجربة لم تنجح حيث انني لاحظت ان الكود يقوم باعادة حساب الاسطر التي يوجد فيها تاريخ ضمن العمود رقم 10 و لا يقوم باعادة الحساب في الاسطر التي لا تحتوي التاريخ في العمود رقم 10

 

اي ان الكود ينفذ عكس المطلوب منه

 

( استاذي يمكنك ملاحظة ذلك اذا قمت بتعديل تاريخ السطر الاول مثلاً من عام 2013 الى عام 2009 و بهذا يجب ان تتغير القيمة الآلية في العمود رقم 13 الى Auto Reject و لكن بعد تنفيذ الكود تبقى القيمة في العمود رقم 13 Auto Pending  و لا تتغير الى Auto Reject )

 

حيث ان المطلوب هو ان يقوم الكود باعادة حساب جميع الاسطر باستثناء الاسطر التي تحتوي ضمن العمود رقم 10 على تاريخ ( او قيمة اكبر من الصفر )

 

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

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

السلام عليكم

أخي العزيز

الكود مضبوط

أذكرك أن الكود ليس في حدث الورقة

أي أنه ليس تلقائي التشغيل ، لابد أن تضغط الزر الأزرق

مايحدث بالورقة نتيجة كود Private Sub Worksheet_Change

غير إسمه مثلا إلي Private Sub Worksheeeet_Change

ستجد المشكلة انتهت

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

أستاذ طارق جزاك الله كل الخير لتفاعلك معي

 

أعرف ان الكود في الملف الذي ارسلته اصبح تنفيذه يتم بعد الضغط على الزر و ليس حدث تلقائي

 

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

 

يمكنك ملاحظة ذلك اذا قمت بتعديل تاريخ السطر الاول مثلاً من عام 2013 الى عام 2009 و بهذا يجب ان تتغير القيمة الآلية في العمود رقم 13 الى Auto Reject و لكن بعد تنفيذ الكود تبقى القيمة في العمود رقم 13 Auto Pending  و لا تتغير الى Auto Reject 

 

حيث ان المطلوب هو ان يقوم الكود باعادة حساب جميع الاسطر باستثناء الاسطر التي تحتوي ضمن العمود رقم 10 على تاريخ ( او قيمة اكبر من الصفر )

 

بارك الله فيك

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

السلام عليكم

أخي العزيز

مرة أخري الكود مضبوط

قم بالتجربة التالية للتأكد بالترتيب التالي

1. غير إسم  كود Private Sub Worksheet_Change إلي  Private Sub CCCC مثلا

____ فسينتقل تأثير الكود من حدث تغيير الورقة

2. غير محتويات الخلية  J6 التي بها تاريخ حديث ، إجعله مثلا 2009

3. إضغط الزر الأزرق ، فلن تجد تغييرا في العمود M

4. أعد إسم  كود Private Sub CCCC  إلي  Private Sub  Worksheet_Change

5. إذهب مرة أخري للخلية  J6 واضغط F2 وإنتر لتحديث التغيير

 

ثم أخبرني النتيجة

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

أستاذ طارق مشكور جداً للتفاعل

 

أؤكد لك انه بعد بعد تغيير تأثير الكود من حدث الورقة و جعله كود ماكرو 

 

و بعد ان تم تغيير محتوى الخلية J6 و بعد الضغط على الزر الازرق للماكرو

 

فإنه تم تحديث حالة M6 و بالتالي اصبحت القيمة الآلية في K6 كالتالي Auto Penading بينما كان طلبي ان يقوم الكود باستثناء الاسطر التي يوجد بها تاريخ ضمن خلية العمود J

 

أما عند تغيير اسم الكود الى Private Sub  Worksheet_Change فإن الملف اعطاني رسالة خطأ عند تحديث التغيير لسبب وجود قسم آخر بذات الاسم ( Private Sub  Worksheet_Change )

و عند تغيير اسم الكود الى اسم Private Sub Worksheet_Calculate فإنه بعد تحديث التغيير قام بتغيير القيمة الآلية في الخلية M من Subscribed إلى Auto Pending

 

بينما اريد ان يقوم الكود ( سواء كان حدث ورقة او ماكرو ) باستثناء هذا السطر لوجود تاريخ ضمن خلية العمود J و عدم تغيير القيمة الآلية من Subscribed إلى Auto Pending

 

جزاك الله خيراً و بارك الله فيك

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

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