ترحيل بيانات المجموع وتقدير الالوان

[محمد زيدان2024]

السلام عليكم مطلوب  كود نسخ تلقائي بيانات المجموع وتقدير الالوان لكل مادة  من ورقة شيت  الى ورقة نتيجة

 

New ورقة عمل Microsoft Excel.xlsb

[Saleh Ahmed Rabie]

**كود نسخ تلقائي بيانات المجموع وتقدير الالوان لكل مادة من ورقة شيت الى ورقة نتيجة**

**الخطوة 1: إنشاء ورقة شيت**

* قم بإنشاء ورقة شيت تحتوي على بيانات المجموع لكل مادة.
* تأكد من تضمين عمود "المادة" وعمود "المجموع".

**الخطوة 2: إنشاء ورقة نتيجة**

* قم بإنشاء ورقة نتيجة تحتوي على عمود "المادة" وعمود "التقدير".

**الخطوة 3: كتابة الكود**

* انتقل إلى ورقة الشيت.
* في شريط القوائم، انتقل إلى "إضافات" > "محررات نصية" > "إنشاء".

* الصق الكود التالي في محرر النصوص:

function copyData() {
  var sheet = SpreadsheetApp.getActiveSpreadsheet().getSheetByName('ورقة شيت');
  var data = sheet.getDataRange().getValues();
  var resultSheet = SpreadsheetApp.getActiveSpreadsheet().getSheetByName('ورقة نتيجة');
  for (var i = 1; i < data.length; i++) {
    var grade = data[1];
    if (grade >= 90) {
      resultSheet.getRange(i + 1, 2).setValue('ممتاز');
    } else if (grade >= 80) {
      resultSheet.getRange(i + 1, 2).setValue('جيد جدا');
    } else if (grade >= 70) {
      resultSheet.getRange(i + 1, 2).setValue('جيد');
    } else if (grade >= 60) {
      resultSheet.getRange(i + 1, 2).setValue('مقبول');
    } else {
      resultSheet.getRange(i + 1, 2).setValue('راسب');
    }
  }
}

* احفظ محرر النصوص.

**الخطوة 4: تشغيل الكود**

* انتقل إلى "إضافات" > "محررات نصية" > "تشغيل" من شريط القوائم.

**النتيجة:**

* سيتم نسخ بيانات المجموع من ورقة الشيت إلى ورقة النتيجة.
* سيتم تقدير الألوان لكل مادة بناءً على المجموع.

**ملاحظة:**

* يمكنك تعديل الكود لتغيير نطاقات الدرجات والتقديرات حسب الحاجة.
* يمكنك أيضًا إضافة المزيد من الأعمدة إلى ورقة النتيجة لعرض معلومات إضافية، مثل التعليقات أو التوصيات.

 

[Saleh Ahmed Rabie]

**كود آخر لنسخ تلقائي بيانات المجموع وتقدير الألوان لكل مادة من ورقة شيت إلى ورقة نتيجة:**`

function copyDataAndGrade() {
  var sheet = SpreadsheetApp.getActiveSpreadsheet().getSheetByName('ورقة شيت');
  var data = sheet.getDataRange().getValues();
  var resultSheet = SpreadsheetApp.getActiveSpreadsheet().getSheetByName('ورقة نتيجة');
  for (var i = 1; i < data.length; i++) {
    var grade = data[1];
    resultSheet.getRange(i + 1, 2).setValue(grade);
    if (grade >= 90) {
      resultSheet.getRange(i + 1, 2).setBackgroundColor('#00FF00');
    } else if (grade >= 80) {
      resultSheet.getRange(i + 1, 2).setBackgroundColor('#FFFF00');
    } else if (grade >= 70) {
      resultSheet.getRange(i + 1, 2).setBackgroundColor('#FF8000');
    } else if (grade >= 60) {
      resultSheet.getRange(i + 1, 2).setBackgroundColor('#FFA500');
    } else {
      resultSheet.getRange(i + 1, 2).setBackgroundColor('#FF0000');
    }
  }
}

**الاختلافات الرئيسية بين الكودين:**

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

 

[خالد المصـــــــــــرى]

م

تم تعديل مايو 23 بواسطه خالد المصـــــــــــرى

[محمد زيدان2024]

ممكن حل @محمد هشام.

[محمد هشام.]

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

مع دكر ما هو شرط تنفيد الكود هل هو ادخال اسم الطالب مثلا في عمود اسـم التلميــــذ او مادا 

 

[محمد زيدان2024]

28 دقائق مضت, محمد هشام. said:

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

مع دكر ما هو شرط تنفيد الكود هل هو ادخال اسم الطالب مثلا في عمود اسـم التلميــــذ او مادا 

 

مثال اللغة العربية في الشيت ناخد منها بيانات المجموع والتقدير وهكذا لكل المواد تروح لصق للنتيجة

New ورقة عمل Microsoft Excel.xlsb

تم تعديل مايو 23 بواسطه محمد زيدان2024

[محمد هشام.]

ادا كنت قد فهمت طلبك بشكل صحيح فهدا سيوفي بالغرض

Sub CopyRanges()
Dim i As Long, r As Long, a As Long, lr As Long
Dim OneRng As Variant, arr As Variant
 
 Dim WS As Worksheet: Set WS = Sheets("شيت")
 Dim f As Worksheet: Set f = Sheets("نتيجةت1")
 
 a = WS.Range("A" & WS.Rows.Count).End(xlUp).Row
  
  lr = f.Columns("D:AD").Find(What:="*", _
   SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
   
Application.ScreenUpdating = False
 For r = 14 To lr
    Union(f.Range("D" & r).Resize(, 14), f.Range("S" & r).Resize(, 12)).ClearContents
 Next r
 
  OneRng = Array("H8:I" & a, "L8:M" & a, "P8:Q" & a, "T8:U" & a, _
        "X8:Y" & a, "AB8:AC" & a, "AF8:AG" & a, "AH8:AQ" & a, "AT8:AU" & a)
                       
  arr = Array("D14", "F14", "H14", "J14", "L14", "N14", "P14", "S14", "AC14")

For i = 0 To UBound(OneRng)
  WS.Range(OneRng(i)).Copy
   f.Range(arr(i)).PasteSpecial xlPasteValues
  Next
  Application.ScreenUpdating = True
  Application.CutCopyMode = False
End Sub

وفي ورقة (نتيجةت1)

Private Sub Worksheet_Activate()
CopyRanges
End Sub

 

New ورقة عمل Microsoft Excel .xlsb

[محمد زيدان2024]

مشكور اخى @محمد هشام. بارك الله فيك

تم تعديل مايو 24 بواسطه محمد زيدان2024