ترحيل جزء من معلومات الورقة الى اخرى

[احمد 505]

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

 

إخواني الاعزاء

 

لقد حصلت على كود رائع وممتاز يفي بمطلبي

بفضل الله ثم

بمساعدة الاخ والاستاذ ياسر خليل

 

واريد عليه بعض التعديل البسيط

 

الكود يعمل كالتالي في ورقة واحدة فقط

 

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

وعند كتابة درجه جديده وتاريخها

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

وهكذا حتى ارصد 5 درجات وتاريخها

 

المطلوب هو

 

اريد ان اعمل على ورقتين

الورقة الاولى فقط ادخل الدرجة الاولى وتاريخها في كل مرة

 

وعند تحديث الدرجه والتاريخ تلقائياً ترحل السابقة

الى الورقة الثانية

( الورقة الثانية اريد فيها 4 درجات مرحله بالاضافة الى الدرجة الحالية  الت موجوده في الورقة الاولى

يعني الورقة الثانية يكون فيها عدد 5 درجات وتاريخها

 

اتمنى تكون وضحت الصورة

اشكركم جميعا

_Move Data Using Worksheet_Change - نسخة.rar

[احمد 505]

لازلت انتظر

لإحساسي انه يوجد من يعمل

لإيجاد حل لسؤالي

اشكر الجميع

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

الأخ الفاضل ... أحمد

جرب الملف التالي ويا رب يفي بالغرض

 

 

Move Data To Another Sheet Using Worksheet_Change.rar

[احمد 505]

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

الاستاذ والاخ ياسر

اسعد الله صباحك

اشكرك على هذا المجهود الرائع

وهذا هو ما اريد بالضبط بارك الله فيك

 

ولكن عندما اردت ان انسخ الكود من الورقتين

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

لم اجد الكود اجد فقط     Option Explicit

في كل الورقتين

 

ارجوا تكتبلي الكود بالموقع

الكود الى بالورقة الاولى والى بالورقة الثانية

اشكرك

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

اضغط دبل كليك على Sheet1 من نافذة المشروع

ستجد الكود .........

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge > 1 Then Exit Sub
    If Target.Row > 2 Then
        If Target.Column = 2 Then
            Sheets("Sheet2").Cells(Target.Row, "M").Value = Sheets("Sheet2").Cells(Target.Row, "K").Value
            Sheets("Sheet2").Cells(Target.Row, "K").Value = Sheets("Sheet2").Cells(Target.Row, "I").Value
            Sheets("Sheet2").Cells(Target.Row, "I").Value = Sheets("Sheet2").Cells(Target.Row, "G").Value
            Sheets("Sheet2").Cells(Target.Row, "G").Value = Sheets("Sheet2").Cells(Target.Row, "E").Value
            Sheets("Sheet2").Cells(Target.Row, "E").Value = Target.Value
        End If
        If Target.Column = 3 Then
            Sheets("Sheet2").Cells(Target.Row, "N").Value = Sheets("Sheet2").Cells(Target.Row, "L").Value
            Sheets("Sheet2").Cells(Target.Row, "L").Value = Sheets("Sheet2").Cells(Target.Row, "J").Value
            Sheets("Sheet2").Cells(Target.Row, "J").Value = Sheets("Sheet2").Cells(Target.Row, "H").Value
            Sheets("Sheet2").Cells(Target.Row, "H").Value = Sheets("Sheet2").Cells(Target.Row, "F").Value
            Sheets("Sheet2").Cells(Target.Row, "F").Value = Target.Value
        End If
    End If
End Sub

[احمد 505]

استاذ ياسر

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

 

معليش أنا غلبتك معاية

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

ويطلعلي خط اصفر وخط بني على المعادلة ورسالة خطأ

فعرفت انني مخطئ في شيئ انا لا اعرف ماهو

واتوقع عشان اختلاف أسماء الورق ما عرفت اغيره في الكود 

لان عندي حوالي 14 ورقة في نفس القاعدة وبأسماء مختلة

 

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

 

الورقة الاولى  التي ادخل فيها فقط الدرجة والتاريخ أسمها ALL INFO   عمود الدرجة  AK وعمود التاريخ AL واذا كان ضروري الصف فيكون 92

والورقة الثانية التي تحتفظ بالخمس النتائج أسمها ELS وتكون من العمود H  الى العمود  Q و الصف يكون 6

 

اشكرك يالحبيب

 

أشكرك

_Move Data To Another Sheet Using Worksheet_Change - نسخة.rar

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

تفضل أخي الغالي

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge > 1 Then Exit Sub
    If Target.Row > 91 Then
        If Target.Column = 37 Then
            Sheets("ELS").Cells(Target.Row - 86, "P").Value = Sheets("ELS").Cells(Target.Row - 86, "N").Value
            Sheets("ELS").Cells(Target.Row - 86, "N").Value = Sheets("ELS").Cells(Target.Row - 86, "L").Value
            Sheets("ELS").Cells(Target.Row - 86, "L").Value = Sheets("ELS").Cells(Target.Row - 86, "J").Value
            Sheets("ELS").Cells(Target.Row - 86, "J").Value = Sheets("ELS").Cells(Target.Row - 86, "H").Value
            Sheets("ELS").Cells(Target.Row - 86, "H").Value = Target.Value
        End If
        If Target.Column = 38 Then
            Sheets("ELS").Cells(Target.Row - 86, "Q").Value = Sheets("ELS").Cells(Target.Row - 86, "O").Value
            Sheets("ELS").Cells(Target.Row - 86, "O").Value = Sheets("ELS").Cells(Target.Row - 86, "M").Value
            Sheets("ELS").Cells(Target.Row - 86, "M").Value = Sheets("ELS").Cells(Target.Row - 86, "K").Value
            Sheets("ELS").Cells(Target.Row - 86, "K").Value = Sheets("ELS").Cells(Target.Row - 86, "I").Value
            Sheets("ELS").Cells(Target.Row - 86, "I").Value = Target.Value
        End If
    End If
End Sub

[احمد 505]

استاذ ياسر

لو سمحت ايش تقصد بالرقم 86

 

انا طلبت الورقة ALL INFO  تبدء من الصف 92   واعتقد انك اشرت اليه بالرقم 91

وطلبت في الورقة ELS  تبدء من الصف 6

 

والا اعلم ايش فايدة الرقم 86

 

لان الكود ما اشتغل معاية

اشكرك

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

أخي الكود يعمل بشكل ممتاز

جرب الملف التالي

‫Move Data To Another Sheet Using Worksheet_Change V1.rar

[احمد 505]

استاذ ياسر

ممكن تشرحلي الرقم 86 ايش يعمل

 

وهل له علاقة بالصفحة ALL INFO

او بالصفحة ELS

 

اشكرك

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

الأخ الحبيب أحمد

الرقم 86 يمثل حاصل طرح رقم الصف 92 - رقم الصف 6 لأتحصل على النتيجة الصحيحة ... حيث أن الصفوف غير متطابقة في ورقتي العمل ..أرجو أن تكون قد اتضحت الصورة لديك

[احمد 505]

بيض الله وجهك

اخي الكريم

 

تمت العملية بنجاح

تم تطبيق الكود على قاعدة بياناتي

 

بس باقي عندي أشياء كمالية وليست ضرورية

ولكن حبيت اسئلك ممكن اجد عندك لها حل

1- اذا مسحت معلومات الدرجة وتاريخها في الورقة ALL INFO  هل من طريقة تمسح من الورقة ELS

2- هل من طريقة تحفظ لي التسلسل في الورقة ELS  مع الورقة ALL INFO

مثلا

 

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

 

طبعا عن طريق استخدام التصفية ممتاز

بس عن طريق الفرز لا ادري

 

اشكرك

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

طيب نقطة نقطة عشان متوهش منك

بتقول "اذا مسحت معلومات الدرجة وتاريخها في الورقة ALL INFO  هل من طريقة تمسح من الورقة ELS"

طيب دا بيحصل .. إذا قمت بمسح الدرجة والتاريخ فإنها تمسح أيضاً من الورقة ELS ؟؟؟

[احمد 505]

صحيح اخي ياسر

بيمسح فقط نفس الدرجة الى في اول خانه من ورقة ELS

ولكن الدرجات السابقة الي في 2 + 3 + 4 + 5  بتبقى

لا بد تمسح يدوياً

على كل حال هذي مش مشكلة انا قلت هذي كماليات فقط

وكنت بسأل اذا فيه طريقه تمسح تلقائياً او لا

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

جرب التالي ..

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge > 1 Then Exit Sub
    If Target.Row > 91 Then
        If Target.Column = 37 Then
            Sheets("ELS").Cells(Target.Row - 86, "P").Value = Sheets("ELS").Cells(Target.Row - 86, "N").Value
            Sheets("ELS").Cells(Target.Row - 86, "N").Value = Sheets("ELS").Cells(Target.Row - 86, "L").Value
            Sheets("ELS").Cells(Target.Row - 86, "L").Value = Sheets("ELS").Cells(Target.Row - 86, "J").Value
            Sheets("ELS").Cells(Target.Row - 86, "J").Value = Sheets("ELS").Cells(Target.Row - 86, "H").Value
            Sheets("ELS").Cells(Target.Row - 86, "H").Value = Target.Value
        End If
        If Target.Column = 38 Then
            Sheets("ELS").Cells(Target.Row - 86, "Q").Value = Sheets("ELS").Cells(Target.Row - 86, "O").Value
            Sheets("ELS").Cells(Target.Row - 86, "O").Value = Sheets("ELS").Cells(Target.Row - 86, "M").Value
            Sheets("ELS").Cells(Target.Row - 86, "M").Value = Sheets("ELS").Cells(Target.Row - 86, "K").Value
            Sheets("ELS").Cells(Target.Row - 86, "K").Value = Sheets("ELS").Cells(Target.Row - 86, "I").Value
            Sheets("ELS").Cells(Target.Row - 86, "I").Value = Target.Value
        End If
        If IsEmpty(Target.Value) Then Sheets("ELS").Cells(Target.Row - 86, "H").Resize(, 10).ClearContents
    End If
End Sub

وإن كنت لا أرى أن هناك داعي لمثل هذا الأمر ..

الزيادة فقط في سطر واحد بمجرد أن تمسح الدرجة يقوم بمسح الصف الخاص بمحتويات هذا الاسم

[احمد 505]

ما شاء الله تبارك الله

ممتاز جدا

عند المسح في الصفحة الرئيسية بيمسح في الورقة ELS

اشكرك يالحبيب

 

وبالنسبة للفرز انا جربته وان شاء الله انه كويس

 

بس انا ملاحظ انه ما بيحفظ التنسيقات

يعني بكبر الخط وبحط مثلا حدود بين الاسماء والارقام واعمل توسيط  

ولما احفظ وسكر البرنامج

 

افتح من جديد احصله ما حفظ التنسيقات الي انا عملتها

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

بيقراها على انها عدد مثل 49852

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

 

هل ممكن ان الورقة عندي اصبحت مضروبه

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

والا فيه حاجه انا ما اعرفها

 

افدني بارك الله فيك

[احمد 505]

أستاذ ياسر

هل يمكن عمل معادلة تقوم بنفس ما يقوم به الكود الذي تفضلت بعمله انت

مجرد سؤال

لان قاعدة البيانات معضمها قائمة على معادلات

وهذا هو الكود الوحيد

فقلت يمكن مسبب ربكه للصفحة لكثرة الاوامر

عشان كذا سئلت

هل يمكن عمل معادلة تعمل عمل الكود

 

اشكرك يالحبيب انا عارف اني غلبتك معايه

تم تعديل فبراير 28, 2015 بواسطه احمد 505

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

بالنسبة للأكواد .. أفضل أحيانا من المعادلات ، فكثرة المعادلات بالمصنف تسبب إرهاق بينما كثرة الأكواد لا تسبب أي إرهاق

دي وجهة نظر ليس أكثر

[احمد 505]

اخي ياسر

السلام عليكم ورحمة الله

 

الكود شغال وممتاز بارك الله فيك

 

ولكن اصبحت الورقة  ما تحتفض بالتنسيقات

( حجم الخط + الحدود + الالوان + تنسيق التواريخ بتطلع رقم مثل 49587 +

الدرجة مش بتطلع نسبه 80% مثلا بتطلع 8000) اعدلها واعمل حفظ واسكر

البرنامج وافتحه احصل الدنيا محيوسة

مش عارف والله

يمكن ما عرفت اركب الكود الله اعلم

انا افتح الورقة كلك يمين على ALL INFO  تتطلع قائمة اختار  عرض تعليمات البرمجه

تفتح لي صفحة اعمل لصق واعمل حفظ

هل الطريقة صحيحة

 

افدني يالحبيب جزاك الله خير

 والله اني من الساعة 10 صباحا وانا شغال على الكود والتنسيقات والا فائدة

 

اشكرك يالحبيب

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

هل العمل على نفس الملف أم ملف آخر ..

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

الكود تم تجربته ويعمل بدون مشاكل مع التنسيقات ..

عموما جرب الملف المرفق في المشاركة رقم 9 وشوف هل المشكلة التي تتحدث عنها تحدث مع هذا الملف .. وإذا كان فيه مشكلة يرجى تحديدها بدقة لمعالجة الأمر ..

أما إذا كان الملف يعمل بشكل طبيعي إذاً الكود ليس به مشكلة والمشكلة في ملفك الأصلي !!

[احمد 505]

الاخ والاستاذ / ياسر

بارك الله فيك

ونفعك بعلمك

ونفع بك

وزادك علما

اشكرك شكرا جزيلا

لقد طبقت الكود على قاعدة بياناتي واشتغل مضبوط

الحمد لله

اشكرك على تجاوبك معي وعلى صبرك على كثر الاسئلة 

انك رائع في منتدى اروع