المساعدة في فرز و طباعة الكشوفات

[Youssef Hussein]

السلام عليكم

عندي في الملف المرفق كشوفات تحمل درجات معينة للطلاب.

نفترض ان مستعمل الجهاز لا يتقن الاكسل (مش انا طبعا)

أرغب اوفر عليه جهد اصدار و توزيع البيانات

.

ExcelWebsitehelp.xlsx

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

تم تعديل التصميم للشيت حيث النتائج (Target) لتبدو اكثر فهماً

وصغت معيار النجاج 20 الذي هو 40/2 اذا اردت نغييره يمكن ذلك من خلال الكود (Const Fl_num=20)

جرب هذا الكود

Option Explicit

Sub Get_data()
Dim M As Worksheet
Dim Tg As Worksheet
Dim Max_ro%, i%, n As Byte
Dim x%, t%

Const Fl_num = 20
Set M = Sheets("Main")
Set Tg = Sheets("Target")
Max_ro = M.Cells(Rows.Count, 1).End(3).Row

  M.Range("A4:M" & Max_ro).Interior.ColorIndex = xlNone
Tg.Range("B4:M500").Clear
    Select Case Tg.Range("A1")
      Case "الدخول": n = 6
      Case "اللياقة": n = 7
      Case "المهارة": n = 8
      Case "الحاسب": n = 9
      Case Else: Exit Sub
    End Select
    t = 4
  For x = 4 To Max_ro
   If M.Cells(x, n) < Fl_num Then
    Tg.Cells(t, 2).Resize(, 13).Value = _
    M.Cells(x, 1).Resize(, 13).Value
'    M.Cells(x, 1).Resize(, 13).Interior.ColorIndex = 35
   Union(M.Cells(x, n), M.Cells(x, 2)).Interior.ColorIndex = 35
    t = t + 1
   End If
    Next
    If t > 4 Then
      With Tg.Range("B4:N" & t - 1)
       .Borders.LineStyle = 1
       .InsertIndent 1
       .Font.Size = 14
       .Font.Bold = True
      End With
   End If
End Sub

Youssef Hussein.xlsm

[Youssef Hussein]

لك جزيل الشكر علما أن هذا بالضبط ضالتي.

لكن جربت الاستعمال و لا يوجد هناك أي مردود.

هل هناك خطأ؟

لك جزيل الشكر هذا تحديدا ما كنت أبحث عنه.

لكن عندما اشغل الكود لا يعمل.

هل هناك مشكلة من طرفي؟

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

تغيير اسماء الصفحات

الصفحة الأول "Main" والصفحة الاخيرة "Target"