أكاديمية الصقر للتدريب

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


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





تراجع عن اعطاء درجة

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


موضوع مغلق


10-09-2022 12:47 مساء
وليد 99999
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 30-06-2021
رقم العضوية : 22562
المشاركات : 66
الجنس : ذكر
تاريخ الميلاد : 1-1-1999
يتابعهم : 3
يتابعونه : 0
قوة السمعة : 32
 offline 

السلام عليكم ورحمة الله وبركاته
اساتذتي اخوتي 
لدي ورقة عمل فيها درجات الطلاب وتم اضافة درجات القرار للطلاب واثناء الاضافة تحدث اخطاء في الاضافة حيث يحدث في بعض الاحيان ان تكون القائمة طويلة ومتعبه فيحدث اضافة سهوا لطالب في الاساس هو راسب ولا يجوز اضافة درجة القرار له في الملف كود يقوم بالتراجع عن اضافة درجات القرار لكنه يقوم بالتراجع عن جميع الدرجات ماريده هو التعديل على هذا الكود بحيث انه يقوم بالتراجع عن اضافة درجة القرار للطلاب الراسبون فقط الموجودة في العمود(R6:R45) ويترك بقية الدرجات على حالها بعد اضافة القرار .
وجزاكم الله خيرا 
 
 
  تراجع.xlsm   تحميل xlsm مرات التحميل :(2)
الحجم :(452.336) KB



أفضل إجابة مقدمة من YasserKhalil وهي:
وعليكم السلام
جرب التعديل التالي عله يفي بالغرض بإذن المولى
Sub UndoMarks()
    Dim i As Long
    Application.ScreenUpdating = False
        For i = 6 To 45
            If InStr(Range("P" & i).Value, Chr(209) & Chr(199) & Chr(211) & Chr(200)) Then
                With Range("D" & i & ":K" & i)
                    .Replace What:="49.5 50", Replacement:="49.5"
                    .Replace What:="49 50", Replacement:="49"
                    .Replace What:="48.5 50", Replacement:="48.5"
                    .Replace What:="48 50", Replacement:="48"
                    .Replace What:="47.5 50", Replacement:="47.5"
                    .Replace What:="47 50", Replacement:="47"
                    .Replace What:="46.5 50", Replacement:="46.5"
                    .Replace What:="46 50", Replacement:="46"
                    .Replace What:="45.5 50", Replacement:="45.5"
                    .Replace What:="45 50", Replacement:="45"
                End With
            End If
        Next i
        With Range("D6:K45").Font
            .Bold = True
            .Name = "Arial"
            .Size = 12
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .Color = -65536
            .TintAndShade = 0
            .ThemeFont = xlThemeFontMinor
        End With
    Application.ScreenUpdating = True
End Sub
عرض الإجابة




16-09-2022 10:32 صباحا
مشاهدة مشاركة منفردة [1]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10444
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 535
قوة السمعة : 36522
عدد الإجابات: 254
 offline 
look/images/icons/i1.gif تراجع عن اعطاء درجة
وعليكم السلام
جرب التعديل التالي عله يفي بالغرض بإذن المولى
Sub UndoMarks()
    Dim i As Long
    Application.ScreenUpdating = False
        For i = 6 To 45
            If InStr(Range("P" & i).Value, Chr(209) & Chr(199) & Chr(211) & Chr(200)) Then
                With Range("D" & i & ":K" & i)
                    .Replace What:="49.5 50", Replacement:="49.5"
                    .Replace What:="49 50", Replacement:="49"
                    .Replace What:="48.5 50", Replacement:="48.5"
                    .Replace What:="48 50", Replacement:="48"
                    .Replace What:="47.5 50", Replacement:="47.5"
                    .Replace What:="47 50", Replacement:="47"
                    .Replace What:="46.5 50", Replacement:="46.5"
                    .Replace What:="46 50", Replacement:="46"
                    .Replace What:="45.5 50", Replacement:="45.5"
                    .Replace What:="45 50", Replacement:="45"
                End With
            End If
        Next i
        With Range("D6:K45").Font
            .Bold = True
            .Name = "Arial"
            .Size = 12
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .Color = -65536
            .TintAndShade = 0
            .ThemeFont = xlThemeFontMinor
        End With
    Application.ScreenUpdating = True
End Sub

18-09-2022 04:38 مساء
مشاهدة مشاركة منفردة [2]
وليد 99999
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 30-06-2021
رقم العضوية : 22562
المشاركات : 66
الجنس : ذكر
تاريخ الميلاد : 1-1-1999
يتابعهم : 3
يتابعونه : 0
قوة السمعة : 32
 offline 
look/images/icons/i1.gif تراجع عن اعطاء درجة
ربي يحفظك ويكثر من امثالك جزاك الله خيرا استاذ

19-09-2022 08:04 صباحا
مشاهدة مشاركة منفردة [3]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10444
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 535
قوة السمعة : 36522
عدد الإجابات: 254
 offline 
look/images/icons/i1.gif تراجع عن اعطاء درجة
وجزيت خيراً بمثل ما دعوت لي أخي الكريم وليد
والحمد لله الذي بنعمته تتم الصالحات



الكلمات الدلالية
تراجع ، اعطاء ، درجة ،


 










اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.

الساعة الآن 05:12 مساء