معادلة كسر القرش

[ناصرالمصرى]

  في 5‏/5‏/2017 at 19:10, ياسر خليل أبو البراء said:

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

ضع الكود التالي في حدث ورقة العمل (كليك يمين على اسم ورقة العمل ثم اختر الأمر 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

 

Expand  

 

  في 5‏/5‏/2017 at 19:29, أ / محمد صالح said:

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

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

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

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

Expand  

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

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

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

نعم أخى تم تغير البيانات والنتيجة 100% ولكن إعتقاد اخى الفاضل / محمد صالح فى محله

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

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

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

برجاء الاطلاع **** شاكر فضلكم جميعا وجزاكم الله خيرا

كسر الجنيه بظام العمود الواحد.rar

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

الملف مختلف والعمود الذي يتم نسخ البيانات منه ليس عمود القروش كما في الملف الذي تم العمل عليه ، وحاولت فهم المطلوب في الملف الجديد لكن غير واضح

أين عمود القروش المطلوب نسخه؟

[ناصرالمصرى]

إخوانى وأحبائى فى الله

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

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

أخى الفاضل الاستاذ / ياسر خليل

بعد طلب الاذن بشأن الكود المرسل من طرفكم يخص كسر الجنيه بنظام عمودى القرش والجنيه

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

حتى لا يتم إدخاله في الحساب مرة أخرى " وهذا ماحدث بالفعل "

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

حيث يبدأ من العمود CK  رقم 89 وحتى العمود DV  رقم 126

علما بأن العمود الخاص بكسر الجنية هو خلايا العمود DT  رقم 124

برجاء الاطلاع **** شاكر فضل الجميع **** وجزاكم الله خيرا

الاستاذ الفاضل محمد صالح.rarFetching info...

الاستاذ الفاضل ياسر خليل.rarFetching info...

تم تعديل مايو 6, 2017 بواسطه ناصرالمصرى

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

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

إذا كان الأمر يخص المسح أضف سطر يقوم بمسح الخلية الهدف والسطر كفيل بإنهاء المشكلة

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, "AN").Value = Cells(Target.Row, "AR").Value
            Application.EnableEvents = True
        End If
    End If
End Sub

** ملحوظة : يفضل العمل على ملف مرفق واحد فقط معبر عن الملف الأصلي لكي لا يحدث تشتت ..الرجاء الانتباه لتلك الملحوظة 

تقبل تحياتي

[ناصرالمصرى]

أخى الفاضل الاستاذ / ياسر خليل

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

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

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

ولكن لا أدرى لماذا لا يعمل الكود بالشكل الصحيح فى المرفق الخاص بوضع كسر الجنية بعمود واحد

أرجو الافادة بعد طلب الاذن من حضراتكم *** شاكر فضلكم **** وجزاكم الله خيرا

 

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

وعليكم السلام أخي الكريم ناصر

ارفق الملف المطلوب العمل عليه مع توضيح الأعمدة المطلوب العمل عليها وورقة العمل .. وآلية العمل وبعض النتائج المتوقعة لأفهم المشكلة حيث أنني غير متابع الموضوع من بدايته

تقبل تحياتي

[ناصرالمصرى]

أخى الفاضل الاستاذ / ياسر خليل

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

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

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

مع تحديد الاعمدة المعنية بالنتائج دون جدوى

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Row > 7 Then
        If Target.Column >= 89 And Target.Column <= 100 Then
            Application.EnableEvents = False
                Cells(Target.Row, "CT").Value = ""
                Cells(Target.Row, "CT").Value = Cells(Target.Row, "CV").Value
            Application.EnableEvents = True
        End If
    End If
End Sub

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

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

كسر الجنية بعمود واحد.xlsb.rarFetching info...

تم تعديل مايو 6, 2017 بواسطه ناصرالمصرى

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

جرب الكود التالي

Sub Test()
    Dim sh As Worksheet, i As Long, rng As Range, y, z
    
    'اسم ورقة العمل
    Set sh = Sheets("Sheet1")

    Application.ScreenUpdating = False
    
        'مسح النطاق المطلوب وضع النتائج فيه
        sh.Range("CT8:CT100").ClearContents
        
        'حلقة تكرارية من الصف رقم 8 إلى الصف رقم 100
        For i = 8 To 100
        
            'تعيين نطاق لعمود الصافي
            Set rng = sh.Range("CV" & i)
            
            If rng.Value = "" Then
                rng.Offset(0, -2).Value = ""
            Else
                y = Application.WorksheetFunction.Floor(rng.Value, 1)
                z = Application.WorksheetFunction.Round((rng.Value - y), 2)
                If z = 0 Then z = ""
                rng.Offset(0, -2).Value = z
            End If
        Next i
    Application.ScreenUpdating = True
End Sub

والأفضل وضعه في كود وتنفيذه مرة واحدة فقط .. أفضل من التعامل مع التغير في حدث ورقة العمل

إذا أردت التغير في ورقة العمل حاول تدرس الكود وتطبقه بنفسك .. للتدريب (أما أنا لا أحبذ التعامل مع التغير في ورقة العمل في هذه الحالة ، حيث لا داعي لذلك)

[أ / محمد صالح]

  في 6‏/5‏/2017 at 17:59, ناصرالمصرى said:

أخى الفاضل الاستاذ / ياسر خليل

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

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

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

مع تحديد الاعمدة المعنية بالنتائج دون جدوى

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Row > 7 Then
        If Target.Column >= 89 And Target.Column <= 100 Then
            Application.EnableEvents = False
                Cells(Target.Row, "CT").Value = ""
                Cells(Target.Row, "CT").Value = Cells(Target.Row, "CV").Value
            Application.EnableEvents = True
        End If
    End If
End Sub

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

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

كسر الجنية بعمود واحد.xlsb.rarFetching info...

Expand  

بعد إذن حبيبنا الغالي أبا البراء

وعلى نفس طريقة الكود السابق

فقط يمكن تعديله إلى

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Row > 7 Then
        If Target.Column >= 89 And Target.Column <= 100 Then
            Application.EnableEvents = False
                Cells(Target.Row, "CT").Value = ""
                Cells(Target.Row, "CT").Value = Cells(Target.Row, "CV").Value - Int(Cells(Target.Row, "CV").Value)
            Application.EnableEvents = True
        End If
    End If
End Sub

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

[ناصرالمصرى]

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

أخى الفاضل الاستاذ / محمد صالح

أخى الفاضل الاستاذ / ياسر خليل

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

جزاكم الله خيرا وبارك فيكم  جميعا  على هذة المشاركات القيمة بقيمة أخلاقكم الكريمة

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

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

 

 

[أ / محمد صالح]

وإياكم أستاذ ناصر

الحمد لله الذي هدانا لهذا وما كنا لنهتدي لولا أن هدانا الله

[ناصرالمصرى]

بارك الله فيكم اخى وحبيبى فى الله محمد صالح

من الصبح عمال اقول الموضوع ناقص إنتهايه يعنى int هههههههههه

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

فلا تحرمنى من تواجداك معى ولكن عايزين المنتدى ينور بإسمك الغالى يعنى بلاش طاقية الاخفاء

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

[أبو سجده]

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

وبه نستعين

ما أحلى الصحبة الطيبة المباركة العامرة بطيب القلوب الصافيه بصفاء النفوس والسماء

بعد إذن جميع السادة الاخوة الافاضل مع حفظ الالقاب / ناصر المصرى - سليم حاصبيا - محمد صالح - ياسر خليل ابو البراء

إثراءا للموضوع اليكم حل أخر بالمعادلات يشتمل على الطريقيتين فى مرفق واحد أرجو أن يفى بالغرض 

أولا طريقة العمود الواحد

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

=MOD(CO8-SUM(CP8:CS8);1)

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

=SUM(CP8:CS8)+MOD(CO8-SUM(CP8:CS8);1)

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

=CO8-SUM(CP8:CS8)-MOD(CO8-SUM(CP8:CS8);1)

ثانيا طريقة عمودين القرش والجنيه

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

  أما عن باقى معادلات الملف تبقى كما هى " ونقى اللى على كيفيك ياعم ناصر" ولاتنسى دعواتك للجميع

=MOD(100*SUM(CL13;CK13/100);100)-MOD(SUM(100*SUM(CN13;CP13;CR13;CT13);CM13;CO13;CQ13;CS13);100)

 الحمد لله الذي هدانا لهذا وما كنا لنهتدي لولا أن هدانا الله **** تقبلوا وافر احترامى وتقديرى وجزاكم الله خيرا

 

 

كسر الجنية بالمعادلات - سعيد بيرم.rarFetching info...

تم تعديل مايو 7, 2017 بواسطه ابو عبدالرحمن بيرم

[ناصرالمصرى]

الله الله الله

ماهذا الجمال أخى سعيد بيرم " أبو عبد الرحمن "

وختامها مسك والله كفيت ووفيت بجد والله لا أصدق نفسى 

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

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

[أ / محمد صالح]

فكرة رائعة أستاذ سعيد

وهروب جميل من circular reference 

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

[أبو سجده]

  في 7‏/5‏/2017 at 17:35, أ / محمد صالح said:

فكرة رائعة أستاذ سعيد

وهروب جميل من circular reference 

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

Expand  

استاذى وأخى // محمد صالح

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

انا قلت فى عقل بالى ياواد يابيرم سيبك من المرجع وخليك من على الدائرى أسرع 

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

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

 

تم تعديل مايو 7, 2017 بواسطه ابو عبدالرحمن بيرم

[أبو سجده]

أخى الفاضل // ناصر المصرى

السلام عليكم

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

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