(تمت الاجابة) ما الخطأ فى هذا الكود (كود ترحيل)

[يوسف عطا]

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

عند نقله إلى ورقة أخرى مع تعديل طفيف أصبح لا يعمل

الكود يرحل البيانات من شيت رقم 23 إلى شيتات رقم 24 و 25 و 26

معيار الترحيل موجود فى أول عمود

Dim Z As Integer, A As Integer, B As Integer, C As Integer

Sheets("24").Range("A11:DZ5000").ClearContents

Sheets("25").Range("A11:DZ5000").ClearContents

Sheets("26").Range("A11:DZ5000").ClearContents

A = 11: B = 11: C = 11

Application.ScreenUpdating = False

For Z = 11 To 5000

If Cells(Z, 1) = "ناجحة" Then

Range("A" & Z).Resize(1, 33).Copy

Sheets("24").Range("A" & A).PasteSpecial xlPasteValues

Application.CutCopyMode = False

A = A + 1

End If

If Cells(Z, 1) = "لها حق" Then

Range("A" & Z).Resize(1, 33).Copy

Sheets("25").Range("A" & B).PasteSpecial xlPasteValues

Application.CutCopyMode = False

B = B + 1

End If

If Cells(Z, 1) = "ليس لها حق" Then

Range("A" & Z).Resize(1, 33).Copy

Sheets("26").Range("A" & C).PasteSpecial xlPasteValues

Application.CutCopyMode = False

C = C + 1

End If

Next

For Y = 24 To 26

Sheets(Y).[B11] = 1

rrw = Sheets(Y).[B3000].End(xlUp).Row

For Each cc In Sheets(Y).Range("B12:B" & rrw)

cc.Value = cc.Offset(-1, 0) + 1

Next cc

Next Y

MsgBox ("الحمد لله تـــم ترحيل الطالبات كل إلى شيت نتيجتها طبقاً للإحصاء التالى ")

For x = 24 To 26

Y = Sheets(x).[B3000].End(xlUp).Row - 10

mssg = mssg & Chr(10) & Format(Y, "00") & " Students to Sheet : " & x

Next x

MsgBox (" تم ترحيل عدد" & mssg)

Range("A1").Select

Application.ScreenUpdating = True

End Sub

[رجب جاويش]

أخى الفاضل / يوسف عطا

بعد التحية

يرجى وضع الملف الذى يطبق علية الكود

لان ذلك يسهل معرفة مكان الخلل

[رجب جاويش]

أخى الفاضل / يوسف عطا

بالنسبة للجزء التالى من الكود

For y = 24 To 26

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

وعند تغيير الأرقام لتناسب الموجود بجوار كلمة sheet فان الكود يعمل تمام ان شاء الله

[يوسف عطا]

عزيزى الغالى رجب بك جاويش

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

بالنسبة للجزء الذى ذكرته سيادتكم بخصوص أن الكود يتعامل مع رقم الشيت وليس مع إسمه الذى يوجد غالباً بين القوسين

هل يمكن تعديل الكود ليتعامل مع إسم الشيت وليس رقمه ؟؟

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

ياريت التعديل يتم على اساس التعامل مع إسم الشيت الموجود فى علامة تبويب الشيت والذى يوجد بين القوسين

ألف شكر يا الغالى

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

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

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

For Y = 2 To 4

Sheets(Y).[B11] = 1

rrw = Sheets(Y).[B3000].End(xlUp).Row

For Each cc In Sheets(Y).Range("B12:B" & rrw)

cc.Value = cc.Offset(-1, 0) + 1

Next cc

Next Y

MsgBox ("الحمد لله تـــم ترحيل الطالبات كل إلى شيت نتيجتها طبقاً للإحصاء التالى ")

For x = 2 To 4

Y = Sheets(x).[B3000].End(xlUp).Row - 10

mssg = mssg & Chr(10) & Format(Y, "00") & " Students to Sheet : " & x

Next x

MsgBox (" تم ترحيل عدد" & mssg)

Range("A1").Select

Application.ScreenUpdating = True

End Sub

تم تعديل نوفمبر 9, 2012 بواسطه يوسف عطا

[رجب جاويش]

أخى الفاضل / يوسف عطا

تفضل أخى

سيكون التعديل بالشكل التالى

For Y = 24 To 26

Sheets(Sheet & Y).[B11] = 1

rrw = Sheets(Sheet & Y).[B3000].End(xlUp).Row

For Each cc In Sheets(Sheet & Y).Range("B12:B" & rrw)

cc.Value = cc.Offset(-1, 0) + 1

Next cc

Next Y

MsgBox ("الحمد لله تـــم ترحيل الطالبات كل إلى شيت نتيجتها طبقاً للإحصاء التالى ")

For x = 24 To 26

Y = Sheets(Sheet & x).[B3000].End(xlUp).Row - 10

mssg = mssg & Chr(10) & Format(Y, "00") & " Students to Sheet : " & x

Next x

MsgBox (" تم ترحيل عدد" & mssg)

Range("A1").Select

Application.ScreenUpdating = True

End Sub

[يوسف عطا]

الف شكر رجب بك

جارى التجربة

[يوسف عطا]

مع الأسف لم يعمل الكود بعد التعديل

[رجب جاويش]

أخى الفاضل / يوسف عطا

أرجو إرفاق الملف لتطبيق الكود عليه

[يوسف عطا]

حاضر يا غالى هارفق الملف حالاً

وبعد إذنك هاطلب طلب تانى لو تقدر

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

علماً بأن إسم الفصل موجود فى العمود FV فى الشيت رقم 7 ودرجات الطلبة فى نفس الشيت فى أعمدة متعددة لو حضرتك عملت المعادلة لمادة واحدة مثلاً

اللغة العربية فى الخلية E8 فى شيت 31

المطلوب وضع أعداد الراسبين الموجودين فى شيت رقم 7 فى العمود L إللى درجتهم أقل من 20 وطبعاً الشرط إن يكونوا فى الفصل رقم 1 إللى هو موجود فى العمود FV فى الشيت 7

أنا هحاول أطبقها على باقى المواد فى باقى الفصول فى الترمين

أما بالنسبة لكود الترحيل اللى شغالين عليه من أول المشاركة فهو فى موديول رقم 6 ترحيل_د2 وزر تشغيله فى صفحة 23 ومفروض يقوم بالترحيل لشيتات رقم 24 و 25 و 26 مع عمل سلسلة للبيانات المرحلة وإستخراج إحصاء لها

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

علماً بأن الملف ثقيل ويحفظ التعديلات ببطئ فالرجاء كن صبوراً معه

وهو إصدار أوفيس 2003

إسم المستخدم يوسف

الباسوورد 111

تم ضغط الملف مرتين للتمكن من رفعه مباشرة هنا

New folder.rar

[رجب جاويش]

أخى الفاضل / يوسف عطا

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

بالنسبة لأعداد الراسبين تم عمل احصائية اللغة العربية فى الجدول الأول لجميع الفصول

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

مع ملاحظة صغيرة

عدد الفصول فى الجداول فى شيت 31 هو 21 فصل بينما فى شيت 7 يوجد 22 فصل

ثانيا بالنسبة لكود الترحيل الموجود فى شيت 23

عند الغاء الخيار Option Explicit الموجود فى بداية الكود فان الكود يعمل بشكل سليم

حيث أن الجملة Option Explicit تستدعى أن يتم تعريف جميع المتغيرات الموجودة فى الكود والا تظهر رسالة خطأ

كما تم تعديل بسيط فى شروط الترحيل داخل الكود

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

وليس ناجحة أو لها حق أو ليس لها حق كما كان فى الكود

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

مع خالص تحياتى

أخوك / رجب جاويش

يوسف.rar

[يوسف عطا]

الف شكر يا غالى

الله ينور عليك