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

[عامر ياسر]

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

الشرح مرفق داخل الملف

aamir.xlsm

[سليم حاصبيا]

ريما يكون المطلوب

تم التعديل على بنية الجدول لحسن عمل الكود

من شروط الاكسل لأي جدول (حدود الجدول يمينا  يساراً  فوق  وتحت يجب ان تكون حلايا فارغة و يمنع دمج الخلايا ضمن الجدول)

لذلك اضفت عامود فارغ (العامود  DU)

في المرة القادمة تجنب دمج الخلايا والاعمدة والصفوف (الصفوف من 21 الى 23)

والا سأتوقف عن المساعدة (تضييع وقت في تنسيق الجداول)

الكود

 

Option Explicit
Sub Give_matiere()
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
Dim My_arr()
Dim My_col$, x%: x = 24
Dim k%, i%, y%
Dim lr%: lr = Range("DD21").CurrentRegion.Rows.Count + 20
My_arr = Array(116, 117, 118, 119, 120, 121, 122, 123)
Range("DV24").Resize(lr, 7).ClearContents
    For k = 0 To UBound(My_arr)
       For i = x To lr
         If Cells(i, My_arr(k)) = 50 Then
          y = Application.CountA(Cells(i, "DV").Resize(1, 7))
          Cells(i, "DV").Offset(, y) = Cells(21, My_arr(k))
         End If
       Next
    Next
   Erase My_arr
   With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub

الملف مرفق

aamir_salim.xlsm

[سليم حاصبيا]

نفس الملف بالمعادلات

هذه المعادلة توضع في الخلية  DV24  مع (Ctrl+Shift+Enter)    معادلة صفيف  و تسحب يساراً 7 أعمدة و نزولاً الى اخر صف فيه بيانات 

=IF(COLUMNS($DV$24:DV$24)>COUNTIF($DL24:$DS24,50),"",INDEX($DL$21:$DS$21,SMALL(IF($DL24:$DS24=50,COLUMN($DL24:$DS24)-COLUMN($DL24)+1),COLUMNS($DV$24:DV$24))))

الملف مرفق

aamir_salim1.xlsm

[عامر ياسر]

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

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

بمعنى اريد الدرجات التي اختلفت من الجدول الاول عن الجدول الثاني 

مثلاً   احمد5 لم تتغير الدرجات الجدول الاول عن درجات الجدول الثاني اي لم يحصل على درجة قرار .... من الملاحظ في الكود والمعادلة تكتب المواد التي درجتها 50 وهذا ليس المطلوب وانما المطلوب هو كتابة المواد التي تغيرت درجتها في الجدول الثاني بالنسبة للجدول الاول وقد قمت بتغير التنسيق الشرطي حتى يكون واضح انه المواد او الدرجات في الجدول الثاني لا تساوي درجات الجدول الاول 

بمعنى انه احمد1 يكون التغيير في اللغة الانكليزية والعلوم

واحمد2 فقط اللغة الانكليزية

واحمد3 و احمد4 واحمد5 واحمد6 واحمد7 لاتوجد مواد قرار

شكرا جزيلاً لك استاذي الكريم سليم على اجاباتك الرائعة .. عسى ان يكون الشرح واضح ...... وعذرا قد اثقلت عليك بالكلام 

aamir_salim.xlsm

[سليم حاصبيا]

تم التعديل لا حظ  (الصفوف من 21 الى 23)

الماكرو

Option Explicit

Sub find_deffrence()
Application.ScreenUpdating = False
 Dim My_Sh As Worksheet: Set My_Sh = Sheets("ورقة1")
 Dim last_row%: last_row = My_Sh.Cells(Rows.Count, "DD").End(3).Row
 Dim My_Rg As Range: Set My_Rg = My_Sh.Cells(22, "dd").Resize(last_row - 21, 16)
  Dim m%: m = 0
 Dim col%
 Dim My_St$
 Dim y%, k%: k = 1
 My_Sh.Range("DV22:EC" & last_row).ClearContents

    For k = 1 To My_Rg.Rows.Count
       For col = 1 To 8
         If My_Rg.Cells(k, 1).Offset(, m).Offset(, 8) <> _
          My_Rg.Cells(k, 1).Offset(, m) Then
          y = Application.CountA(Cells(k + 21, "DV").Resize(1, 8))
          My_St = My_Rg.Cells(k, 1).Offset(, m).Offset(-k)
          Cells(k + 21, "DV").Offset(, y) = My_St & " : " _
          & Abs((My_Rg.Cells(k, 1).Offset(, m).Offset(, 8)) _
          - (My_Rg.Cells(k, 1).Offset(, m)))
          End If
        m = m + 1
      Next
        m = 0
     Next
Application.ScreenUpdating = True
End Sub

الملف

 

aamir_salim modfier.xlsm

[عامر ياسر]

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

سؤالي لماذا تضهر المواد بهذا الشكل    ( الانكليزي:12 او العلوم:1 ) هل يمكن ان تكتب المواد فقط انكليزي او علوم 

[سليم حاصبيا]

الرفم الذي يظهر هو الفرق بالعلامات

يمكن ازالته اذا كنت تريد باستدال هذا السطر من الكود

Cells(k + 21, "DV").Offset(, y) = My_St & " : " _
          & Abs((My_Rg.Cells(k, 1).Offset(, m).Offset(, 8)) _
          - (My_Rg.Cells(k, 1).Offset(, m)))

يهذا

Cells(k + 21, "DV").Offset(, y) = My_St 

 

[عامر ياسر]

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

[عامر ياسر]

بعد الان ليس هناك دمج للصفوف ... خوفاً من عدم الاجابة

لتلطيف الجو فقط :ههههه

تم تعديل يوليو 22, 2018 بواسطه عامر ياسر

[سليم حاصبيا]

2 دقائق مضت, عامر ياسر said:

بعد الان ليس هناك دمج للصفوف ... خوفاً من عدم الاجابة

لتلطيف الجو فقط :ههههه

صدقتي يا ياسر

الجو ليس معكراً ابداً 

هناك عشرات المشاركات التي اقدم لها هذه النصيحة (لوجه الله) حتى ان هذه النصيحة صارت محفوظة عندي و اعمل لها   Copy Paste

والقليل منهم يستجيب  (والعجب كل العجب لست انا المستفيد)

[عامر ياسر]

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

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

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

تم تعديل يوليو 22, 2018 بواسطه عامر ياسر

[سليم حاصبيا]

12 دقائق مضت, عامر ياسر said:

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

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

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

انا افهم ان الذي قلته هو مزاح

يا سيدي امزح  كما يحلو لك  و كيفما يحلو لك و أينما يحلو  لك  وانا احب المزاح ولا اتضايق منه ابداً