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

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

قام بنشر (معدل)

أحبائى الكرام

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

أعتذر عن إنقطاعى خلال الفترة الماضية لظرف مرضى طارىء

بعد إذن حضراتكم أريد معادلة مفادها لو أن الفرق الناتج من طرح جملة المستحق - جملة المستقطع أقل من أو يساوى 99 قرش

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

شاكر فضل الجميع وجزاكم الله خيرا

كسرالقرش.rarFetching info...

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

السلام عليكم أخى سليم

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

صراحة الكود أكثر من رائع  ولكن أريد إظهار الفرق فى العمود  I  نظرا لانه يمثل بند منفصل 

أما عن الاعمدة الفارغة برجاء التفضل بالتصويب دون وجود اعمدة فارغة وإن حالت الظروف دون ذلك

فأرجو التبديل إلى معادلة تفى لنفس الطلب هذا بعد طلب الاذن من سيادتكم

شاكر فضل حضرتك وجزاكم الله خيرا

كسرالقرش Salim+11.rar

قام بنشر (معدل)
  في 2‏/5‏/2017 at 11:10, ناصرالمصرى said:

السلام عليكم أخى سليم

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

صراحة الكود أكثر من رائع  ولكن أريد إظهار الفرق فى العمود  I  نظرا لانه يمثل بند منفصل 

أما عن الاعمدة الفارغة برجاء التفضل بالتصويب دون وجود اعمدة فارغة وإن حالت الظروف دون ذلك

فأرجو التبديل إلى معادلة تفى لنفس الطلب هذا بعد طلب الاذن من سيادتكم

شاكر فضل حضرتك وجزاكم الله خيرا

كسرالقرش Salim+11.rarFetching info...

Expand  

بواسطة المعادلات لا تستطيع عمل ذلك لانك تقع في مشكلة Circular Reference

تم التعديل على الماكرو لاظهار الفرق في العامود I و جمعه

كسرالقرش SalimA.rar

تم تعديل بواسطه سليم حاصبيا
  • Like 1
قام بنشر (معدل)

جزاكم الله خيرا  أخى سليم

إبداع منقطع النظير ****نعم تم جمع وإظهار الفرق فى العمود I

ولكن بقيت خطوة العمود H كما هو فراغ وهذا الفراغ أثر سلبا على الملف الاصلى

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

شاكر فضل حضرتك وجزاكم الله خيرا

تم تعديل بواسطه ناصرالمصرى
قام بنشر (معدل)

تم التعديل على الكود بدون تفريغ العامود H

انظر الى الصفحة salim

الكود مرفق (لعدم اظهار المجموع للعامود I) يمكن تعطيل السطر الاخير من الكود (قبل End Sub)

و ذلك بكتابة فاصلة عليا في بدايته

الكود:

Option Explicit
Sub extract_data()
 Dim My_Rg, Cel As Range
 Dim Roow, Cool As Integer
 Dim StrJ, StrI, StrH As String
 Dim OldVal
 If ActiveSheet.Name <> "salim" Then Exit Sub
  
  StrJ = "=D2-I2": StrJ = Replace(StrJ, Chr(34), Chr(34) & Chr(34))
  StrI = "=SUM(E2:G2)": StrH = Replace(StrI, Chr(34), Chr(34) & Chr(34))
  StrH = "=IF(j2="","",MOD(j2,1))": StrH = Replace(StrH, Chr(34), Chr(34) & Chr(34))

 Set My_Rg = Sheets("salim").Range("A1").CurrentRegion
 Roow = My_Rg.Rows.Count
 Cool = My_Rg.Columns.Count
 Set My_Rg = My_Rg.Offset(1).Resize(Roow - 1).Offset(0, Cool - 3).Resize(Roow - 1, 3)
' My_Rg.Select
 '////////////////////////////////////////////////////////////
   My_Rg.Columns(2).Cells(1).Resize(Roow - 1).Formula = StrI
  My_Rg.Columns(3).Cells(1).Resize(Roow - 1).Formula = StrJ
  My_Rg.Columns(1).Cells(1).Resize(Roow - 1).Formula = StrH
   '==========================================
  OldVal = My_Rg.Columns(1).Cells(1).Resize(Roow - 1).Value
    '==============================================
     For Each Cel In My_Rg.Columns(2).Cells(1).Resize(Roow - 1)
     Cel.Value = Cel.Value + Cel.Offset(0, -1).Value
     Next
     '======================================
   My_Rg.Columns(1).Cells(1).Resize(Roow - 1) = OldVal
   My_Rg.Columns(1).Cells(1).Resize(Roow - 1).Offset(Roow).Cells(1) = Application.Sum(OldVal)
 
 
 '\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
End Sub

 

 

كسرالقرش معدل.rarFetching info...

تم تعديل بواسطه سليم حاصبيا
  • Like 1
قام بنشر (معدل)

اخى الفاضل الاستاذ / سليم

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

بارك الله فيك وأعطاكم الصحة والعافية وأمد فى عمركم

بسم الله ماشاء الله تعديل مميز من شخصية أكثر تميزا 

تم التعديل ليتوافق مع الملف الاصلى ولكن على مايبدو هناك مشكلة فى إزاحة الاعمدة الى الاعمدة المطلوبة

حيث غيرت فى أرقام الاعمدة بصراحة حاولت ولكن اليك المرفق التالى حسب نطاقات الملف الاصلى

ستجده فى الموديول naserelmasry  برجاء التفضل بمواصلة مسيرتكم العطرة نحو هذا الموضوع

مع قبول اعتذارى لشعورى بأننى أثقل عليك فى طلبى هذا

شاكر فضل حضرتك وجزاكم الله خيرا

كسرالقرش معدل - الاستاذ سليم حاصبيا.xlsb.rarFetching info...

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

بعد إذن أخي وحبيبي في الله الأستاذ سليم حاصبيا

جرب هذا المرفق أخي الكريم

بكود بسيط يمكن أن يؤدي الغرض

Sub addkasr()
c = Cells(Rows.Count, "A").End(xlUp).Row
Range("h2:h" & c).ClearContents
For n = 2 To c
Range("h" & n) = Range("j" & n) - Int(Range("j" & n))
Next
MsgBox "ok"
End Sub

 

mas_كسرالقرش.rar

  • Like 1
قام بنشر

أخى وحبيبى فى الله الاستاذ الفاضل / محمد صالح

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

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

نعم حبيبى فى الله الكود أدى الغرض تماما

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

اليك المرفق التالى برجاء الاطلاع والافادة بإذن الله

شاكر فضل حضرتك وجزاكم الله خيرا

mas_كسر الجنية ذو الخانتين.rar

قام بنشر

كدا أسهل

وكنت أرجو أن تحاول فيها أولا

إنما العلم بالتعلم والمحاولة والخطأ

جرب تغيير الكود لهذا

Sub addkasr()
c = Cells(Rows.Count, "AR").End(xlUp).Row
Range("an8:an" & c).ClearContents
For n = 8 To c
Range("an" & n) = Range("ar" & n)
Next
MsgBox "ok"
End Sub

 

  • Like 1
قام بنشر

اخى وحبيبى فى الله الاستاذ / محمد صالح

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

عندما تتسم الاكواد بالبساطة والسحر على غير المعتاد

فحتما تختلط الاوراق جزاكم الله عنا خير الجزاء وشكرا للجميع

على هذة المساهمات الطيبة *** شاكر فضل الجميع *** وجزاكم الله خيرا

  • Like 1
قام بنشر

بارك الله فيك أستاذي الكبير محمد صالح على حلولك الرائعة ، والله لقد دبت الروح في المنتدى بعد عودتك إليه

سؤال لما استخدمت الحلقات التكرارية في كودك الأخير .. في حين يمكن عدم استخدامها بهذا الشكل

Sub AddKasr()
    Dim c As Long

    c = Cells(Rows.Count, "AR").End(xlUp).Row

    With Range("AN8:AN" & c)
        .ClearContents
        .Value = Range("AR8:AR" & c).Value
    End With
    
    MsgBox "OK"
End Sub

 

  • Like 1
قام بنشر

بارك الله لك أستاذ ياسر

طريقة أخرى لتنفيذ المطلوب

وبنفس عدد سطور الكود (٦ سطور)

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

  • Like 2
قام بنشر (معدل)
  في 5‏/5‏/2017 at 07:27, أ / محمد صالح said:

بارك الله لك أستاذ ياسر

طريقة أخرى لتنفيذ المطلوب

وبنفس عدد سطور الكود (٦ سطور)

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

Expand  

استاذ محمد 

كود رائع بسيط و معبّر بارك الله بك و باعمالك

لكن عندما قيل لي ا ن الاعمدة متحركة في الجدول (تارة يريد البيانات في العامود AR وطوراً في غيره)  اضطررت الى اعداد الكود الذي ادرجته في مشاركتي

تم تعديل بواسطه سليم حاصبيا
  • Like 1
قام بنشر (معدل)
  في 5‏/5‏/2017 at 07:19, ياسر خليل أبو البراء said:

بارك الله فيك أستاذي الكبير محمد صالح على حلولك الرائعة ، والله لقد دبت الروح في المنتدى بعد عودتك إليه

 

  في 5‏/5‏/2017 at 08:03, سليم حاصبيا said:

استاذ محمد 

كود رائع بسيط و معبّر بارك الله بك و باعمالك

Expand  

 

Expand  

نعم أخى الفاضل  ابو البراء وأخى الفاضل سليم

والله والله لقد دبت الروح فى المنتدى بعودة الاستاذ الفاضل محمد صالح

بارك الله فيكم جميعا  وجزاكم خيرا **** ولى طلب بعد إذنكم جميعا

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

شاكر فضل حضراتكم جميعا وجزاكم الله خيرا 

تم تعديل بواسطه ناصرالمصرى
قام بنشر
  في 2‏/5‏/2017 at 14:48, سليم حاصبيا said:

بواسطة المعادلات لا تستطيع عمل ذلك لانك تقع في مشكلة Circular Reference

Expand  

المرجع الدائري معناه أن الخلية الموجود بها المعادلة
ضمن المرجع المحسوب في المعادلة
يعني في حالتنا هذه
خلية كسر الجنيه محسوبة ضمن إجمالي المستقطع

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

فلا يمكن وضع معادلة تخص الصافي في خلية كسر الجنيه

  • Like 1
قام بنشر (معدل)

أخى وحبيبى فى الله الاستاذ / محمد صالح

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

انا معك قلبا وقالبا وأدرك تماما  ماتقصده

ولكن برجاء تجربة تغيير قروش اى مبلغ هنا لابد من الضغط على زر تنفيذ الكود كلما جد جديد

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

معلش انا بحاول اوصل الفكرة لان باقى الملف مصمم بالمعادلات مش عارف بقى الكلام ده منطقى أم على غير ذلك

شاكر فضل حضرتك وجزاكم الله خيرا

تم تعديل بواسطه ناصرالمصرى
قام بنشر (معدل)

أخى وحبيبى فى الله الاستاذ / ياسر خليل

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

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

فهل يمكن رجاءا  ابداء رأيكم  الحكيم  مشفوعا بمرفق من طرفكم

لإعتقادى أنه قد يطرأ تغيرا  أو تعديل فى مجريات الامور

شاكر فضل حضرتك وجزاكم الله خيرا

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

وعليكم السلام

ضع الكود التالي في حدث ورقة العمل (كليك يمين على اسم ورقة العمل ثم اختر الأمر View Code والصق الكود التالي)

قم بوضع أية بيانات في الأعمدة من AD إلى AW ولاحظ النتيجة في العمود AN

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Row > 7 Then
        If Target.Column >= 30 And Target.Column <= 49 Then
            Application.EnableEvents = False
                Cells(Target.Row, "AN").Value = Cells(Target.Row, "AR").Value
            Application.EnableEvents = True
        End If
    End If
End Sub

 

  • Like 1
قام بنشر

بارك الله لك أستاذ ياسر

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

حتى لا يتم إدخاله في الحساب مرة أخرى

وحتى نحصل على الصافي بدون قروش

  • Like 2

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.

×
×
  • اضف...

Important Information