سليم حاصبيا

جرب المرفق صفحة test Book1 salim 1.rar

جرب هذا الكود Sheets_Add.rar

جرب هذا المرفق Book1 salim.rar

يمكنك استعمال Freeze Top Row 1- من خلال التبويب اختر Freeze Panes 2- Freeze Top Row

يمكنك تجربة هذا الماكرو Refresh_By_Names _Macro 2.rar

يعمل لغاية 30 اسم (اذا كنت تريد اكثر استبدل في المعادلة الرقم 31 بالرقم الذي تريده واسحب نزولاً) لا تنس بعد استبدال الرقم 31 بالرقم الذي تريده ان تضغط Ctrl+Shift+Enter وليس Enter وحدها لان المعادلة (صفيف) بالنسبة لتعدد لاسماء فوق 500 اسم يصبح البرنامج بطيء نظراً لكثرة المعادلات في هذه الحالة الكود اسرع

جرب هذا الملف انه يقوم بترتيب الاسماء حسب من لديه اكبر حساب و يغرض في الخلية المجاورة حسابه مع عدم تكرار الاسم يعمل لغاية 30 اسم (اذا كنت تريد اكثر استبدل في المعادلة الرقم 31 بالرقم الذي تريده) Refresh_By_Names.rar

تم التعديل على الملف يمكنك كتابة ما تريد أو الاختيار من القائمة Excel report salim 1.rar

اثراءً للموصوع هذا الملف Adress_Values.rar

جرب هذا الملف zz salim.rar

جرب هذا الملف (انه يعمل لغاية الخلية E150 و يمكن الزيادة اذا اردت) Excel report salim.rar

جرب هذه المعادلة =VLOOKUP(ROUND(MOD(B2/12,1)-1/1000,1),{0,0;0.1,0.25;0.2,0.25;0.3,0.25;0.4,0.5;0.5,0.5;0.6,0.5;0.7,0.75;0.8,1;0.9,1},2)+INT(B2/12)

اسمحوا لي باضافة هذا الكود Sub EXEMLPE() i = 6 Do Until Cells(i, "M") = Empty With Cells(i, "M") If .Value = "ناجح" Then x = 1 Else x = 0 If .Value = "مكمل بدرس" Then y = 2 Else y = 0 If .Value = "مكمل بدرسين" Then t = 2 Else t = 0 If .Value = "مكمل بثلاث دروس" Then m = 2 Else m = 0 If .Value = "راسب" Then Z = 3 Else Z = 0 End With Cells(i, "O") = Application.Max(x, y, Z, m, t) i = i + 1 Loop End Sub ربما هذا الكود اسرع قليلاً حيث انه ينتقل اى قيمة I الثانية فور العثور على النتيجة Sub EXEMLPE2() i = 6 Do Until Cells(i, "M") = Empty With Cells(i, "M") If .Value = "ناجح" Then .Offset(0, 2) = 1: GoTo Nexxt If .Value = "مكمل بدرس" Then .Offset(0, 2) = 2: GoTo Nexxt If .Value = "مكمل بدرسين" Then .Offset(0, 2) = 2: GoTo Nexxt If .Value = "مكمل بثلاث دروس" Then .Offset(0, 2) = 2: GoTo Nexxt If .Value = "راسب" Then .Offset(0, 2) = 3 End With Nexxt: i = i + 1 Loop End Sub

اسمحوا لي باضافة هذا الكود Sub EXEMLPE() i = 6 Do Until Cells(i, "M") = Empty With Cells(i, "M") If .Value = "ناجح" Then x = 1 Else x = 0 If .Value = "مكمل بدرس" Then y = 2 Else y = 0 If .Value = "مكمل بدرسين" Then t = 2 Else t = 0 If .Value = "مكمل بثلاث دروس" Then m = 2 Else m = 0 If .Value = "راسب" Then Z = 3 Else Z = 0 End With Cells(i, "O") = Application.Max(x, y, Z, m, t) i = i + 1 Loop End Sub ود

حرب هذه المعادلة في الخلية C2 واسحب نزولا" =IF($B2<>"",IF(OR(MOD($B2/12,1)<3/10,MOD($B2/12,1)<6/10,MOD($B2/12,1)<9/10),FLOOR($B2/12,0.25),CEILING($B2/12,0.25)),"")

جرب هذا الملف المصنف2 Salim.rar

املأ قليلاً من البيانات في الجدول (ولو 20 صف) لا يجوز ان نعمل مع جدول فارغ وليس لدينا الوقت لادراج بيانات عشوائية على 15000 صف و اكثر

تفضل الحل Filter_for_me.rar

مجدداً بعض المعادلات التي تتعلق بالتاريخ عسى ان تنال الاعجاب exacte d m y.rar

ربما يكون هذا الكود اسرع Sub Salim_Tarhil() Dim Source_Sheet, Target_Sheet1, Target_Sheet2 As Worksheet Set Source_Sheet = Sheets("بيانات الممنوحين") Set Target_Sheet1 = Sheets("ممنوح"): Set Target_Sheet2 = Sheets("تجميد") Application.ScreenUpdating = False For i = 1 To Sheets.Count With Sheets(i) .AutoFilterMode = False If .FilterMode = True Then .ShowAllData End With Next Target_Sheet1.Range("a10:m1000").ClearContents Target_Sheet2.Range("a10:m1000").ClearContents Source_Sheet.Range("$A$8:$M$1000").AutoFilter Field:=12, Criteria1:="ناجح" Source_Sheet.Range("$A$9:$M$1000").SpecialCells(12).Copy Destination:=Target_Sheet1.Range("a10") Source_Sheet.Range("$A$8:$M$1000").AutoFilter Field:=12, Criteria1:="راسب" Source_Sheet.Range("$A$9:$M$1000").SpecialCells(12).Copy Destination:=Target_Sheet2.Range("a10") ' Source_Sheet.ShowAllData Application.ScreenUpdating = True End Sub

ربما يكون مفيداً هذا الكود Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 3 And Target.Row < 2 And Target.Count <> 1 Then GoTo 1 Application.EnableEvents = False Target.Offset(0, 1).Font.ColorIndex = xlColorIndexNone With Target.Offset(0, 1).Font Bold = True Italic = True End With With Target.Offset(0, 1).Font Select Case Target.Value Case "المقاولات" .ColorIndex = 5 Case "العقارات" .ColorIndex = 3 Case "الصيانة" .ColorIndex = 8 Case "المالية" .ColorIndex = 38 End Select End With 1: Application.EnableEvents = True End Sub

اين هي البيانات لا ارى الا جداول فارغة اضف بعض البيانات وليس كلها فمن اين نعرف مثلاً ما هي علامة النجاح والرسوب و ما هو قرار المجلس الخ....

شرح للكود Private Sub Worksheet_Change(ByVal Target As Range) ' الكود هنا مبني على اساس التغيير في اي خلية بالصفحة 'C1 يضاف شرط فقط اذا كانت الخلية المعنية بالامر هي If Target.Address = "$C$1" Then ' G1 اذا كانت الخلية الهدف يقصد بها تساوي الاسم المقصود الذي ذكر في My_name = Range("c1").Value If My_name = Cells(1, "g") Then ' يتم تغيير لون الخلفية للخلية المجاورة للون الاصفر Target.Offset(0, 1).Interior.ColorIndex = 6 Else 'اذا لم يكن ذلك يكون لون الخلفية عادي Target.Offset(0, 1).Interior.ColorIndex = xlColorIndexNone End If End If End Sub

تم تغيير بعض التنسيقات في الصفحة للحصول على كامل الحساب فقط اختر رقم الفاتورة من القائمة المنسدلة(القائمة المنسدلة مطاطة) عسى ان يكون المطلوب sales prog salim.rar

كيف تبحث عن كل الخلايا التي تحتوي على شيء معين و تستبدلها بشيء اخر موضوع ليس بالجديد لكن يمكن تنفيذه بطريقة غير الكلاسيكية (أقصد غير Find and Replace العادية) Find & replace.rar