ترحيل

**الشيباني1** · يناير 9, 2010

اساتذتنا وخبراؤنا الكرام تحية واحترام ارجو المساعده في كود لترحيل البيانات التي تتضمنها الورقه الرئيسيه في المرفق الى اوراق الوكلاء الذين يقرب عددهم من (150) والذين وزعتهم على (15) مجموعه شاكرا جودكم وكرمكم مع الامتنان

المرفق مع الاعتذار

Book1.rar

تم تعديل يناير 9, 2010 بواسطه TareQ M

**طارق محمود** · يناير 9, 2010

السلام عليكم

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

إذا كان ذلك، فلماذا لم تنقل يدوي في المثال أول بيانات في الورقة GRO1 للوكيل A

التاريخ_________القائمه _________الماده _________الكميه _________السعر _________القيمه

04/01/2010_________4 _________15 _________125 _________2.1 _________262.5

تم تعديل يناير 9, 2010 بواسطه TareQ M

**الشيباني1** · يناير 9, 2010

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

**طارق محمود** · يناير 9, 2010

لم أقصد الإشارة إلي عدم إستخدام الكود

فقط أرجو مراجعة الورقة GRO1 للوكيل A

والسؤال هو

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

**الشيباني1** · يناير 9, 2010

استاذنا العزيز في الورقه (MAIN) بيانات يوميه حسب طلب الوكلاء من المواد وهي ترجمة للفواتير المنظمه بهذا الخصوص وتمتد اسطرها لغاية نهاية السنه ولفرز حركة كل وكيل على حده ( اما لغرض المطابقه معه او لاعطائه نسخه تفصيليه من الحركه )ارغب ان ابتعد عن المعادلات التي تثقل البرنامج وتعيق حركته وارجو الاستفاده من خبرتكم في مجال الاكواد بكود وزر ترحيل للبيانات من الورقه الرئيسيه الى وكلاء الشركه حسب مجاميعهم والبيانات التي قمت بتثبيتها في اوراق الوكلاء هي للتوضيح فقط مع الامتنان

**طارق محمود** · يناير 9, 2010

عفوا أخي

لم أقرأ جيدا في الأول

ظننت أنك تريد التجميع من الأوراق إلي الورقه (MAIN)

وكنت قد بدأت في هذا الإتجاه

وهذا الكود غير كامل إن أردت المحاولة

Sub Shift()

x = Worksheets.Count


    For i = 2 To x

        Worksheets(i).Select


            Range("B5").Select

                For j = 0 To 9

                    If ActiveCell.Value > 1 Then GoSub 100: GoSub 200

                    ActiveCell.Offset(0, 8).Select

                Next j

    Next i



100  ' There's a data

            wn = Worksheet.Name                 ' Group Number

            ag = ActiveCell.Offset(-2, 0).Value ' Agent (Wakeel)


            dd = ActiveCell.Value                   ' date

            qa = ActiveCell.Offset(0, 1).Value  ' Qaema (List)


            ad1 = ActiveCell.Address                ' ad = Address

            ActiveCell.Offset(30, 0).Select

            Selection.End(xlUp).Select

            ad2 = ActiveCell.Address

                If ad1 <> ad2 Then GoSub 300 'There's another data

                            'OR  it's only one record

                            ActiveCell.Offset(-1, 3).Select

                            Range(Selection, Selection.End(xlDown)).Select

                            dc = Selection.Rows.Count - 1 'data count

                            Range(ad1).Select


         Return


200


        Return


300


        Return


400

    Next i


End Sub

لأنني مشغول الآن

فإن لم يتدخل أحد الإخوة سوف أبدأ فيها غدا إن شاء الله

**الشيباني1** · يناير 10, 2010

استاذنا العزيز مع تقديري لجهدكم كلي شوق لرؤية ما ستجود به اناملكم وفكركم النير مع الامتنان

**طارق محمود** · يناير 10, 2010

السلام عليكم

تفضل أخي الملف المرفق

Shifttt.rar

**طارق محمود** · يناير 10, 2010

أخي العزيز

لاحظ أن:

1. هذا الماكرو تفصيل فقط علي هذه الحالة

2. لايجوز مثلا تغيير أسماء الورقات إلا بتغييرها في الورقه (MAIN) المجال Q156:P7 بالتحديد لأن البرنامج يقرأ منها البيانات

3. لابد أن يكون الوكلاء داخل الورقات بنفس الترتيب الموضوع بالورقه (MAIN) المجال Q156:P7

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

أعتقد أنه الآن كاف

وفقنا الله وإياكم لما فيه الخير

**الشيباني1** · يناير 10, 2010

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

1- اود ان يكون المدى في الورقة الرئيسية واوراق المجاميع حتى ( 10000)سطر

2- امكانية الترحيل المباشر للبيانات الجديده دون الغاء البيانات القديمه وبحيث لن تتكرر اية بيانات عند الترحيل

شاكرا" اهتمامكم وجهدكم مع الامتنان

**احمد فضيله** · يناير 10, 2010

باشمهندس طارق

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

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

وفقك الله

**طارق محمود** · يناير 10, 2010

1- اود ان يكون المدى في الورقة الرئيسية واوراق المجاميع حتى ( 10000)سطر

الملف الآن ليس محدود بعدد أسطر ، جرب بنفسك وضع اية بيانات في الورقة الرئيسية أكثر من 10000

لو راجعت أول الكود

Worksheets("MAIN").Select


a = WorksheetFunction.CountA(Range("b:b")) - 1

Range("B4").Select


    For i = 1 To a                  ' check how many data rows

    Worksheets("MAIN").Select

حيث يتم عدد البيانات الموجودة بالعمود "b:b" ، الذي يساوي a ،ثم يكرر العملية من 1 إلي a

2- امكانية الترحيل المباشر للبيانات الجديده دون الغاء البيانات القديمه وبحيث لن تتكرر اية بيانات عند الترحيل
شاكرا" اهتمامكم وجهدكم مع الامتنان

بإمكانك ألا تلغي القديم

موضوع التكرر فقط ، هو الذي سيحتاج جولة اخري

**طارق محمود** · يناير 10, 2010

باشمهندس طارق
جزاك الله خيرا

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

وفقك الله

شكرا جزيلا أخي HaNcOcK

علي مرورك وكلماتك الكريمة

**الشيباني1** · يناير 10, 2010

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

**طارق محمود** · يناير 10, 2010

إرسل أخي مرفق به المشكلة

وإن شاء الله تجد لها حلا

**الشيباني1** · يناير 10, 2010

إرسل أخي مرفق به المشكلة

وإن شاء الله تجد لها حلا

أستاذنا العزيز ارجو ملاحظة(N-GRO10)حيث يرحل جزء من البيانات وحتى عند تكرار العمليه تظهر الحالة نفسها ومع كل اضافة وترحيل مع الشكر

Shifttt.rar

**الشيباني1** · يناير 10, 2010

إرسل أخي مرفق به المشكلة

وإن شاء الله تجد لها حلا

أستاذنا العزيز ارجو ملاحظة(N-GRO10)حيث يرحل جزء من البيانات وحتى عند تكرار العمليه تظهر الحالة نفسها ومع كل اضافة وترحيل مع الشكر

عذرا" اخي العزيز (GRO2)وليس (10)

**طارق محمود** · يناير 11, 2010

عندك حق يحدث هذا في حالة آخر بيان في الورقة الرئيسية

تم تدارك هذه الحالة

مرفق الملف الجديد

Shifttt2.rar

**احمد فضيله** · يناير 11, 2010

جزاك الله خيرا يا باشمهندس / طارق

**الشيباني1** · يناير 11, 2010

أستاذنا الكبير مع تقديري واحترامي لحلكم الرائع اسأل العلي القدير ان يبقيكم لنا منقذا" ومرجعا وجزاكم الله كل خير ولدي سؤال أخير أن سمحتم وهو :

أنا تركت في صفحة (Main)العمودين (J,K)يقابلهما في صفحات الوكلاء(H,I)والاعمده الاخرى لاستخدامها لاغراض تتعلق بالحسابات ، أتساءل عن التعديل الواجب عمله في الكود ليتقبل ترحيل البيانات التي اثبتها في عمودي الصفحة الرئيسيه الى صفحات الوكلاء مع الشكر والامتنان تاركا" الرد لحين توفر الوقت المناسب لديكم .

**طارق محمود** · يناير 12, 2010

السلام عليكم

هذا هو الكود بالكامل

Sub Shift_from_Main()

Worksheets("MAIN").Select


a = WorksheetFunction.CountA(Range("b:b")) - 1

Range("B4").Select


    For i = 1 To a                  ' check how many data rows

    Worksheets("MAIN").Select

10      ActiveCell.Offset(1, 0).Select

20        If ActiveCell.Value > 1 Then GoTo 30 ' loop till found there's a data

         GoTo 10


30      ad1 = ActiveCell.Address                            'there's a data

        rw = 1                                                          ' check how many data rows

110           ActiveCell.Offset(1, 0).Select

                   If ActiveCell.Value > 1 Or ActiveCell.Offset(0, 4).Value < 1 Then GoTo 130 ' loop till found next data

                   rw = rw + 1

                   If rw = 20 Then GoTo 900

                 GoTo 110


130       If ActiveCell.Offset(0, 4).Value < 1 Then xx = "STOP"

            Range(ad1).Select


            agnt = ActiveCell.Offset(0, 2).Value                              ' Wakeel - Agent


                For j = 0 To 149           'gr_sht  = the Sheet which have Group which contain that agent

                  If agnt = Range("Q7").Offset(j, 0).Value Then

                                gr_sht = Range("P7").Offset(j, 0).Value

                                pos_ = (j / 10 - Int(j / 10)) * 10

                                GoTo 135

                  End If

                Next j


135       ad2 = ActiveCell.Offset(rw - 1, 1).Address

            ad3 = ActiveCell.Offset(0, 4).Address

            ad4 = ActiveCell.Offset(rw - 1, 7).Address

            Union(Range(ad1, ad2), Range(ad3, ad4)).Select

            Selection.Copy


       Worksheets(gr_sht).Select                    ' going to the correct worksheet

        Range("B4").Offset(100, (8 * pos_ + 3)).Select 'going to the correct Agent-Wakeel position

        Selection.End(xlUp).Select

        ActiveCell.Offset(1, -3).Select

        ActiveSheet.Paste


    If xx = "STOP" Then GoTo 900

    Next i


900

Application.CutCopyMode = False

Worksheets("MAIN").Select

Range("B4").Select

End Sub

فقط عليك بتغيير الرقم 7 إلي 9 في السطر الثالث من العنوان 135 (الخامس عشر من الأسفل لأعلي) الذي كان

  ad4 = ActiveCell.Offset(rw - 1, 7).Address

ليكون

  ad4 = ActiveCell.Offset(rw - 1, 9).Address

**الشيباني1** · يناير 12, 2010

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

تسجيل الدخول

ترحيل

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

الشيباني1

طارق محمود

الشيباني1

طارق محمود

الشيباني1

طارق محمود

الشيباني1

طارق محمود

طارق محمود

الشيباني1

احمد فضيله

طارق محمود

طارق محمود

الشيباني1

طارق محمود

الشيباني1

الشيباني1

طارق محمود

احمد فضيله

الشيباني1

طارق محمود

الشيباني1

Join the conversation

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information