أريد كودين للترحيل من أصعب ما يكون

[EL_Naj3awy]

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

قمت بعمل ملف أكسيل يقوم بمعظم أعمال شئون الطلاب المدرسية

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

كود ترحيل تكوين الفصول جاهز ويعمل بكفاءة

الأكواد الناقصة هى كالتالى

*- سجل قيد الطلاب المستجدين

*- سجل قيد الطلاب الباقين

*- سجل 41 مستجدين

ملاحظات

سجل 41 مستجدين يكتب فيه الطلاب المستجدين فقط

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

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

توجد بعض الدوال الجاهزة فى السجلات المراد التحويل إليها

مثل استخراج اسم والد الطالب واستخراج السن فى أول أكتوبر

مرفق الملف كامل وبه بعض البيانات للتجربة

فى انتظار ردودكم

شئون الطلاب 2018.rar

[EL_Naj3awy]

انا جاتلى فكرة بس عاوز المساعدة

انا ممكن اعمل الترحيل عن طريق تسجيل الماكرو

بس مش عاوزة تظبط معايا خالص

فى انتظار المساعدة

وعلى فكرة انا عاوز اتعلم مش بس انقل كود وخلاص

[EL_Naj3awy]

فين المساعدة

[EL_Naj3awy]

للرفع

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

حدد المطلوب بالضبط ليتمكن الأخوة من الرد في الموضوع بدلاً من الرفع بدون فائدة .. وضح بالصور واجعل المطلوب شيء واحد فقط مع وضع بعض النتائج المتوقعة ..

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

[EL_Naj3awy]

اللى انا فهمته من حضرتك انى اطلب فى كل مرة حاجة واحدة وتكون واضحة

ماشى

الملف كامل مرفوع فى المرفقات

فى صفحة بيانات الطلاب انا بكمل كل البيانات المطلوبة

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

طبعا بشرط أن يكون الطالب مستجد

ياريت يكون طلبى واضح

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

السلام عليكم .. جرب الكود التالي عله يفي بالغرض

Sub TransferNonAdjacentUsingArrays()
    Dim ws          As Worksheet
    Dim sh          As Worksheet
    Dim kName       As String
    Dim arr         As Variant
    Dim temp        As Variant
    Dim i           As Long
    Dim j           As Long
    Dim p           As Long

    Set ws = Sheets("بيانات الطلاب")
    Set sh = Sheets("سجل قيد الطلاب المستجدين")
    kName = "مستجد"

    Application.ScreenUpdating = False
        arr = ws.Range("B17:T" & ws.Range("B" & Rows.Count).End(xlUp).Row).Value
        temp = sh.Range("B11:P" & UBound(arr, 1)).Formula
        
        For i = 1 To UBound(arr, 1)
            If arr(i, 5) = kName Then
                p = p + 1
                temp(p, 2) = arr(i, 2)
                temp(p, 4) = arr(i, 7)
                temp(p, 5) = arr(i, 8)
                temp(p, 6) = arr(i, 9)
                temp(p, 10) = arr(i, 13)
                temp(p, 11) = arr(i, 4)
                temp(p, 12) = arr(i, 5)
                temp(p, 14) = arr(i, 11)
                temp(p, 15) = arr(i, 12)
            End If
        Next i
    
        If p > 0 Then sh.Range("B11").Resize(p, UBound(temp, 2)).Value = temp
    Application.ScreenUpdating = True
End Sub

 

[EL_Naj3awy]

الكود ممتاز

بارك الله فيك

يتبقى كود لعمل

سجل 41 مستجدين

فى نفس الملف

ملحوظة صغيرة

طبعا بشرط أن يكون الطالب مستجد أو مستجدة

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

أخي الكريم 

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

[EL_Naj3awy]

أستاذ ياسر

تم اكتشاف مشكلة

ورغم محاولتى إلا أنها لم تفلح

أريد ترحيل الطالبة المستجدة

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

فقط يتم ترحيل الطالب المستجد فقط

أرجو حل هذه المشكلة

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

غير السطر التالي

If arr(i, 5) = kName Then

إلى

If arr(i, 5) Like kName Then

 

[EL_Naj3awy]

للأسف لم يفلح معى

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

هل جربت نفس الحل الذي قدمته في الموضوع الآخر .. باستخدام دالة INSTR ...؟!