ناصر سعيد

كيفية ترتيب تقديرات الطلاب وماشابهها للعلامة ياقشير اعزه الله ترتيب مجموعات.rar

كيفية ترتيب تقديرات الطلاب وماشابهها للعلامة ياقشير اعزه الله ترتيب مجموعات.rar

Option Explicit Sub SortTable() 'code written by Dave Peterson 2005-10-22 Dim myTable As Range Dim myColToSort As Long Dim curWks As Worksheet Dim mySortOrder As Long Dim LastRow As Long Dim iCol As Integer Dim strCol As String iCol = 20 '10 columns strCol = "b" ' column to check for last row Set curWks = ActiveSheet With curWks myColToSort = .Shapes(Application.Caller).TopLeftCell.Column LastRow = .Cells(.Rows.Count, strCol).End(xlUp).Row Set myTable = .Range("a6:a" & LastRow).Resize(, iCol) If .Cells(myTable.Row + 1, myColToSort).Value _ < .Cells(LastRow, myColToSort).Value Then mySortOrder = xlDescending Else mySortOrder = xlAscending End If myTable.Sort key1:=.Cells(myTable.Row, myColToSort), _ order1:=mySortOrder, _ header:=xlYes End With End Sub كود المرفق السابق

فرز لجدول كامل انت تحدده وبعلوميه اي عمود تبغاه فرز راائع.rar

اشكرك اخي على تنبيهك لي بتغيير اسم الظهور الملف يعمل تماما وهو 2003

فرز لجدول كامل انت تحدده وبعلوميه اي عمود تبغاه Option Explicit Sub SortTable() 'code written by Dave Peterson 2005-10-22 Dim myTable As Range Dim myColToSort As Long Dim curWks As Worksheet Dim mySortOrder As Long Dim LastRow As Long Dim iCol As Integer Dim strCol As String iCol = 20 '10 columns strCol = "b" ' column to check for last row Set curWks = ActiveSheet With curWks myColToSort = .Shapes(Application.Caller).TopLeftCell.Column LastRow = .Cells(.Rows.Count, strCol).End(xlUp).Row Set myTable = .Range("a6:a" & LastRow).Resize(, iCol) If .Cells(myTable.Row + 1, myColToSort).Value _ < .Cells(LastRow, myColToSort).Value Then mySortOrder = xlDescending Else mySortOrder = xlAscending End If myTable.Sort key1:=.Cells(myTable.Row, myColToSort), _ order1:=mySortOrder, _ header:=xlYes End With End Sub فرز راائع.rar

=SUMPRODUCT((INDEX(البيانات;0;2)=B21)*(INDEX(البيانات;0;3)=C21)*(INDEX(البيانات;0;5)=D21))

مرفق اخر لنفس الموضوع بمعادله اخرى =DCOUNTA(البيانات;1;معيار2) =SUMPRODUCT((INDEX(البيانات;0;2)=B21)*(INDEX(البيانات;0;3)=C21)*(INDEX(البيانات;0;5)=D21)) احصائيات.rar

=DCOUNTA(البيانات;1;معيار2) مرفق اخر لنفس الموضوع بمعادله اخرى احصائيات.rar

تقييد الخلايا بارقام معينه في وجود حرف ال غ حاول ان تكتب في العمود الملون باللون الاصفر =OR(AND(D6>=1;D6<=10);D6="غ";D6="غـ";D6="غايب")

تقييد الخلايا بارقام معينه في وجود حرف ال غ =OR(AND(D6>=1;D6<=10);D6="غ";D6="غـ";D6="غايب") حاول ان تكتب في العمود الملون باللون الاصفر التحقق من الصحة.rar

كود اضافة الدوائر الحمرا ويعمل بطريقة فريده يمكنك استخدام تكبير او تصغير العرض بدون التاثير في وضع الدوائر في اماكنها (سيعمل الكود بدون مشاكل) ActiveWindow.Zoom صف الدرجات متغير هنا الصف رقم 12 اذا كانت الخلية في هذا الصف ليست رقم .. لا تتم اضافة دائرة في صفوف عمود الخلية عمود رقم الجلوس العمود متغير هنا رقم 2 اذا كان هذا العمود فاضي او صفر لن تتم اضافة الدوائر تم عمل زر مزدوج لإضافة وحذف الدوائر باسم (الدائرة) Sub اضافة_حذف() On Error Resume Next Dim XX As Shape Set XX = ورقة3.Shapes("الدائرة") With XX.TextFrame.Characters If .Text = "اضافة الدوائر" Then Circles1 .Text = "حذف الدوائر" Else RemoveCircles1 .Text = "اضافة الدوائر" End If End With On Error GoTo 0 End Sub Sub Circles1() Dim C As Range Dim MyRng As Range Dim V As Shape Dim X As Integer Dim G As Integer, R As Integer '================================================ ' عمود رقم الجلوس G = 2 ' صف الدرجات R = 12 ' نطاق الخلايا الذي تريد اضافة الدوائر فيها Set MyRng = Range("N13:BQ47") '================================================= ' اذا كانت النطاقات مختلفة يمكنك الاشارة اليهم بالتالي 'Set MyRng = Range("O13:O47,Q13:Q47,S13:S47") '================================================= X = ActiveWindow.Zoom Application.ScreenUpdating = False ActiveWindow.Zoom = 100 For Each C In MyRng If Cells(C.Row, G) = 0 Then GoTo 1 If IsNumeric(Cells(R, C.Column)) And Not IsEmpty(Cells(R, C.Column)) And (C.Value < Cells(R, C.Column) Or C.Value = "غ" Or C.Value = "غـ") Then Set V = ActiveSheet.Shapes.AddShape(msoShapeOval, C.Left + 1, C.Top + 1, C.Width - 2, C.Height - 2) V.Fill.Visible = msoFalse V.Line.ForeColor.SchemeColor = 10 V.Line.Weight = 1.25 End If 1 Next ActiveWindow.Zoom = X Application.ScreenUpdating = True End Sub Sub RemoveCircles1() Dim shp As Shape For Each shp In ActiveSheet.Shapes If shp.AutoShapeType = msoShapeOval Then shp.Delete Next shp End Sub دعوة طيبه لوحه الله لكل من ساهم في هذا العمل اضافة و حذف دوائر_2.rar

كود اضافة الدوائر الحمرا ويعمل بطريقة فريده يمكنك استخدام تكبير او تصغير العرض بدون التاثير في وضع الدوائر في اماكنها (سيعمل الكود بدون مشاكل) ActiveWindow.Zoom صف الدرجات متغير هنا الصف رقم 12 اذا كانت الخلية في هذا الصف ليست رقم .. لا تتم اضافة دائرة في صفوف عمود الخلية عمود رقم الجلوس العمود متغير هنا رقم 2 اذا كان هذا العمود فاضي او صفر لن تتم اضافة الدوائر تم عمل زر مزدوج لإضافة وحذف الدوائر باسم (الدائرة) Sub اضافة_حذف() On Error Resume Next Dim XX As Shape Set XX = ورقة3.Shapes("الدائرة") With XX.TextFrame.Characters If .Text = "اضافة الدوائر" Then Circles1 .Text = "حذف الدوائر" Else RemoveCircles1 .Text = "اضافة الدوائر" End If End With On Error GoTo 0 End Sub Sub Circles1() Dim C As Range Dim MyRng As Range Dim V As Shape Dim X As Integer Dim G As Integer, R As Integer '================================================ ' عمود رقم الجلوس G = 2 ' صف الدرجات R = 12 ' نطاق الخلايا الذي تريد اضافة الدوائر فيها Set MyRng = Range("N13:BQ47") '================================================= ' اذا كانت النطاقات مختلفة يمكنك الاشارة اليهم بالتالي 'Set MyRng = Range("O13:O47,Q13:Q47,S13:S47") '================================================= X = ActiveWindow.Zoom Application.ScreenUpdating = False ActiveWindow.Zoom = 100 For Each C In MyRng If Cells(C.Row, G) = 0 Then GoTo 1 If IsNumeric(Cells(R, C.Column)) And Not IsEmpty(Cells(R, C.Column)) And (C.Value < Cells(R, C.Column) Or C.Value = "غ" Or C.Value = "غـ") Then Set V = ActiveSheet.Shapes.AddShape(msoShapeOval, C.Left + 1, C.Top + 1, C.Width - 2, C.Height - 2) V.Fill.Visible = msoFalse V.Line.ForeColor.SchemeColor = 10 V.Line.Weight = 1.25 End If 1 Next ActiveWindow.Zoom = X Application.ScreenUpdating = True End Sub Sub RemoveCircles1() Dim shp As Shape For Each shp In ActiveSheet.Shapes If shp.AutoShapeType = msoShapeOval Then shp.Delete Next shp End Sub دعوه طيبه لوجه الله لكل من ساهم في هذه الملف ( عبد الله باقشير ) اضافة و حذف دوائر_2.rar

معادله جميله وجدتها في كنوزي التي احتفظ بها علها تنفع الاحباب احسنت معادلة باقشير.rar

احصائيات باقوى معادله بشرطين و3 شروط و4 شروط Sum Product احصاء.rar

المرفق Sum Product احصاء.rar

احصائيات باقوى معادله بشرطين و3 شروط و4 شروط

ترحيل بيانات بالقائمة المنسدلة للعلامه عبد الله باقشير ترحيل عن طريق القائمة المنسدله.rar

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

نعم هذا طلبي احب داله اوفست وهذا هو الملف وجدته بالمنتدى وهو عز الطلب بيانات 1.rar

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

وصف الدرجات يقصد به صف النهاية الصغرى 1 الذي يكتب فيه 50 للمادة ذات درجة من 100 اقتباس واين صف دون المستوى

الاستاذ نور انت مهتم بالرد على طلبك وهذا حقك ولذك نرجو ان تجيب طلب الاخ سامي

=IF(OR($N$13<MIN(رقم_الجلوس);$N$13>MAX(رقم_الجلوس));"";INDIRECT(ADDRESS(MATCH(شهادات!$N$13;'بيانات أساسية'!$C$7:$C$600;0)+2;COLUMN()+5;4;;$S$1))) اريد نضبيط هذه المعادلة الموجوده بالمرفق يتم ضبطها في المشاركة 7

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