ابراهيم الحداد

السلام عليكم ورحمة الله نعم اخى العزيز ضع هذه العبارة فى بداية الكود الاول Call DeletingShp

السلام عليكم ورحمة الله استبدل هذه العبارة If shp.Type = msoAutoShape Or shp.Type = msoShapeOval Then shp.Delete بهذه العبارة If shp.Type = msoShapeOval Then shp.Delete

السلام عليكم ورحمة الله اخى الكريم سليم المعادلة تعطى نتيجة لمنتج غير موجود وهو منتج 6 اعتقد ان المعادلة الصحيحة هى =IF(E3="";"";MAX(IF(E3=B$2:B$14;A$2:A$14;0)))

السلام عليكم ورحمة الله اكتب المعادلة التالية : =MAX(IF(E3=B$2:B$14;$A$2:$A$14;"")) ثم اضغط "Crtl + Shift + Enter" ثم اسحب نزولا حتى آخر خلية

السلام عليكم ورحمة الله كود مسح الدوائر Sub DeletingShp() Dim shp As Shape For Each shp In ActiveSheet.Shapes If shp.Type = msoAutoShape Or shp.Type = msoShapeOval Then shp.Delete Next End Sub

السلام عليكم ورحمة الله انسخ هذا الكود و الصقه فى موديول و خصص له زر كما يلى : من قائمة insert ---------- Devolper ثم اضغط على زر من القائمة المنسدلة ورابطه بالكود السابق كما ارجو ان تقوم بازالة التنسيق الشرطى كى ترى الدوائر Sub Circles() Dim ws As Worksheet Dim Arr() As Variant Dim LR As Long, R As Long, i As Long Dim Cel As Range Set ws = Sheets("شيت") If LR < 14 Then LR = 14 LR = ws.Range("C" & Rows.Count).End(xlUp).Row Arr = Array(10, 11, 12, 14, 15, 17, 18, 20, 21, 23, 24, 26, 27, 29, 30, 32, 33, 35, 36, 37) For R = 14 To LR For i = LBound(Arr) To UBound(Arr) For Each Cel In ws.Cells(R, Arr(i)) If Cel.Value < ws.Cells(13, Cel.Column) Or Cel.Value = "غ" Then Set xx = ActiveSheet.Shapes.AddShape(msoShapeOval, Cel.Left, Cel.Top, Cel.Width, Cel.Height) xx.Fill.Visible = msoFalse xx.Line.ForeColor.SchemeColor = 10 xx.Line.Weight = 1.2 End If Next Next Next End Sub

بارك الله فيك استاذنا الكبير متألق كالعادة لا حرمنا الله من ابداعاتك

السلام عليكم ورحمة الله اخى الكريم معذرة على تسرعى استبدل تلك العبارة ws.Range("C9:Q" & ws.Range("D" & Rows.Count).End(xlUp).Row ).ClearContents بتلك العبارة ws.Range("C9:Q" & ws.Range("D" & Rows.Count).End(xlUp).Row + 9).ClearContents اعلم ان الفرق بسيط و لكنى لا اريد تشتيت تفكيرك فالفرق هو + 9 و تأكد ان هذا الامر لن يحدث ثانية باذن الله هذا وبالله التوفيق

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

السلام عليكم ورحمة الله انسخ هذا الكود والصقه بموديول جديد واربطه بالزر الموجود بالملف Sub CallingData() Dim data As Worksheet, ws As Worksheet Dim Arr As Variant, Temp As Variant Dim i As Long, j As Long, p As Long Set data = Sheets("السجل الكلي") Set ws = Sheets("السجل المطلوب") ws.Range("C9:Q" & ws.Range("D" & Rows.Count).End(xlUp).Row).ClearContents Arr = data.Range("D9:R" & data.Range("D" & Rows.Count).End(xlUp).Row).Value ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2)) For i = 1 To UBound(Arr, 1) If Arr(i, 2) = ws.Range("Q2") Then p = p + 1 For j = 1 To 14 Temp(p, j) = Arr(i, Choose(j, 1, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15)) Next End If Next If p > 0 Then ws.Range("D9").Resize(p, UBound(Temp, 2)).Value = Temp If p > 0 Then ws.Range("C9") = 1: ws.Range("C9").Resize(p).DataSeries Step:=1 End Sub

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

السلام عليكم ورحمة الله استخدم دالة Vlookup

السلام عليكم ورحمة الله اخى الكريم الاستاذ سليم تعليقك رائع وفعلا فى محله بارك الله فيك

السلام عليكم ورحمة الله جرب ان تضع هذا الكود فى حدث الصفحة Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Column <> 6 Then Exit Sub Dim LR As Long, R As Integer, x As Integer lngLstRow = ActiveSheet.UsedRange.Rows.Count For R = 6 To lngLstRow Step 30 If True Then x = x + 1 Cells(R, "F").Value = x End If Next End Sub

السلام عليكم ورحمة الله اخى الحبيب الملف لدى يعمل بكفاءة تامة احب ان اوضح لك اساس العمل مبنى على الرقم الادارى للموظف بالشيت الاول وليس اسم الموظف يعنى يجب ان تقوم اولا بكتابة الرقم الادارى فى العمود "C"

السلام عليكم ورحمة الله تم التصحيح Emp.rar

السلام عليكم ورحمة الله تفضل Emp.rar

السلام عليكم ورحمة الله استبدل المعادلات السابقة بالمعادلة الآتية =IF(ISNUMBER(AR5)=FALSE;MAX($A$5:$A$9988)-COUNTIF($AR5:$AR$9988;"غ")+1;RANK(AR5;$AR$5:$AR$253;0)+COUNTIF($AR$5:AR5;AR5)-1)

السلام عليكم ورحمة الله اكتب هذه المعادلة فى الخلية " E3 " =LOOKUP(2;1/(متابعة!$B$3:$B$7=C3);متابعة!$C$3:$C$7) ثم اسحب نزولا

السلام عليكم ورحمة الله استبدل هذه المعادلة =IF(ISNUMBER(AR5)=FALSE;MAX($A$5:$A$9988)-MIN($A$5:$A$9988)+COUNTIF($AR$5:AR5;AR5);RANK(AR5;$AR$5:$AR$253;0)) بهذه المعادلة =IF(ISNUMBER(AR5)=FALSE;MAX($A$5:$A$9988)-MIN($A$5:$A$9988)+COUNTIF($AR$5:AR5;AR5)-1;RANK(AR5;$AR$5:$AR$253;0)+COUNTIF($AR$5:AR5;AR5)-1) ثم اسحب نزولا حتى آخر خلية تريدها

اخى الكريم السلام عليكم ورحمة الله هل الخمس درجات تضاف مباشرة ام لها خلية تسجل فيها اولا وهل هى درجة ثابتة ام مختلفة من طالب الى آخر

السلام عليكم ورحمة الله تفضل تجميع الأوراق في ورقة واحدة.rar

السلام عليكم ورحمة الله تم الحل بطريقة مختلفة اليك الملف تجميع الأوراق في ورقة واحدة.rar

السلام عليكم ورحمة الله اخى الكريم تم عمل المطلوب ما عدا فرز وترتيب الاعمدة بسبب دمج الخلايا اليك الملف New Microsoft Excel Worksheet.rar

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