سليم حاصبيا

تم التعديل على الملف كما تريد ان تظهر الارقام يرجى اعادة التحميل

استاذ ابراهيم تكفي هذه المعادلة =COUNTIF($C$5:C5,C5)+VLOOKUP(C5,{"اعدادي",19100;"ثانوي",19200},2,0)-1 (مع مراعاة الفاصلة والفاصلة المنقوطة)

عسى ان ينال الاعجاب هذا الملف Rakm_Dirassi.xls

اقترح ان تدرج شرح هذا الكود في مشاركة مستقلة كي يطلع عليه الأعضاء ويقوم احدهم بشرحه

استعمل هذا المعادلة =IF(C9="","",SUM($C$9:$C9)-SUM($D$9:$D9))

اعتذر عن شرح الكود لضيق الوقت حصراً لكن لعل احد من الأعضاء الناشطين (الاستاذ علي مثلاً) يتولى هذه المهمة

مثال اخر عن تنسيقات الخلايا في الملف المرفق 1- النطاق الأصفر يحتوي على بيانات (حدد اي خلية منه وانظر الى قيمتها في Formula bar) تنسيقه مخصص "Custom" كل خلية من خلاياه اذا كانت رقماً موجباً تكتب بشكل "OK" اذا كانت رقماً سالباً تكتب بشكل "Negative" اذا كانت صفراً تكتب بشكل "Zero" اذا كانت نصاً تكتب بشكل "Text" 2-النطاق الأخضر يقوم بضرب النطاق الأصفر بـــ 10 تنسيق الأخضر عادي "General" قم بتغيير القيم في النطاق الأصفر و انظر الى النتيجة كل هذا يحدث لان المعادلة تنظر الى محتوى الخلية وليس الى منظرها الخارجي Tansiq.xlsx

صديقي هشام هذه فكرة رائعة لتغيير المنظر الخارجي للخلية فقط وليس قيمتها (المنظر الخارجي 2.67 لكن قيمتها بقيت 2.666666) القيمة الحقيقية يمكن ان تراها (بعد تحديد الخلية) في Formula Bar لتأكيد ذلك اكتب هذه المعادلة في اي مكان و اسحب نزولاً ثم انظر الى النتيجة =D5*1000 2666.666 / 2555.555 وهكذا و ليس 2670 / 2560 (بمعنى اخر اي عملية حسابية على الخلية ،اكسل يعتبرها 2.66666) لان المعادلة تنظر الى محتوى الخلية وليس الى منظرها الخارجي (التنسيبق) هناك طريقة اخرى لتطبيق فكرتك (بيقى ذلك ضمن التنسيق وليس تغيير القيمة)

الملف مع المعادلة celing_fuction.xls

لنفرض ان الرقم عندك في الخلية A1 اكتب هذه المعادلة (للتقريب الى الاعلى) =IF(ISNUMBER(A1),CEILING(A1,0.05),"") و هذه المعادلة (للتقريب للاسفل) =IF(ISNUMBER(A1),FLOOR(A1,0.05),"")

جرب هذا الماكرو Option Explicit Sub my_sum_By_Chosen_Sheets() Dim s#, k%, t1%, t2% On Error GoTo Leave_me_Out t1 = Sheets(Sheets("mn").Range("a15").Value).Index t2 = Sheets(Sheets("mn").Range("b15").Value).Index For k = Application.Min(t1, t2) _ To Application.Max(t1, t2) s = s + IIf(IsNumeric(Sheets(k).Range(Sheets("mn").Range("C15"))), _ Sheets(k).Range(Sheets("mn").Range("C15")), 0) Next Sheets("mn").Range("d15") = s Exit Sub Leave_me_Out: MsgBox "Check Please the Addrees And The Sheet's Names" & Chr(10) & _ "In The Range(A15:C15)" End Sub الملف للمعاينة مرفق sum_from_multy_sheet.xlsm

جرب هذا الملف wafiyat.xlsm

1-لم أر اي سنة تخرج او اي درجة في البيانات 2 - اذا كان ما تقصده مثلاُ هذا الشيء 1980/17 لا ينفع لانه يجب فصل كل رقم في خلية مستقلة

زيادة في التوضيح هذا الملف SpliT_cell_updated.xlsm

جزاك الله خيراَ استاذ علي لكن الـــ Udf تلعب دورها اكثر في حال اختيار اكثر من رقم واحد للتجميع =IFERROR(SALIM_SPLIT($A1,"(\w{2})",COLUMNS($B1:B1)),"") لتفهم قصدي جرب هذه المعادلة في الصف الاول واسحبها يميناً =IFERROR(SALIM_SPLIT($A1,"(\w{2})",COLUMNS($B1:B1)),"")

هات مثالاً عما تريد وخذ ما يدهش العالم على كل حال جرب هذا الملف SpliT_cell.xlsm

شاهذ هذا الفيديو https://www.youtube.com/watch?v=wH03Xnr3Pug

جرب هذا الماكرو دوال الاكسل لا يمكنها تغيير النتسيقات( انها تنظر فقط الى محتوى الخلايا ولا يهمها الخطوط في الخلية ولا اذا كانت مدمجة أو لا) Option Explicit Sub test() Application.ScreenUpdating = False Range("B8").CurrentRegion.Clear Range("B2").CurrentRegion.Copy Range("B8") Range("B8").CurrentRegion.UnMerge Range("C10").Cut Range("C9") Range("B10:d10").Clear Application.ScreenUpdating = True End Sub الملف مرفق Small_example.xlsm

هناك الكثير من الأكواد حول هذا الموضوع لكن الكود في هذا الملف يستطيع ان يفصل الاسماء المركبة حتى الاسم الرابع و أكثر مع اضافة تنسيقات تلوينية للنتائج و القدرة على اضافة بعض الأسماء الأولى للاسم المركب (عبد , أبو , سيف , جمال الخ....) Option Explicit Sub split_names() Application.ScreenUpdating = False Dim my_st$, st1, st2 Dim last_col% Dim my_name, i%, k%, Col%, int_col% Dim Lr%: Lr = Cells(Rows.Count, 1).End(3).Row Dim mon_range As Range Dim fin_rg As Range Range("b2").Resize(Lr - 1, 10).Clear Dim arr: arr = _ Array("سيف", "عبد", "أبو", "ابو", "عز", "صدر", "نور") '++++++++++++++++++++++++++++++++++++++ Rem Array تستطيع ان تضيف اي بداية اسم مركب داخل هذا الــ '+++++++++++++++++++++++++++++++++++++ For i = 2 To Lr If Range("a" & i) = vbNullString Then GoTo Next_i my_st = Trim(Range("a" & i)) my_name = Split(Trim(my_st)) Range("b" & i).Resize(1, UBound(my_name) + 1) = my_name Next_i: Next '============================== For i = 2 To Lr last_col = Cells(i, Columns.Count).End(1).Column Set mon_range = Range(Cells(i, 2), Cells(i, last_col)) For k = 1 To last_col - 1 If Not (IsError(Application.Match(mon_range.Cells(k), arr, 0))) Then st1 = mon_range.Cells(k): st2 = mon_range.Cells(k + 1) mon_range.Cells(k).Delete Shift:=xlToLeft mon_range.Cells(k) = st1 & " " & st2 End If Next Next Set fin_rg = Range("a1").CurrentRegion Lr = fin_rg.Rows.Count Col = fin_rg.Columns.Count With fin_rg.Offset(1).Resize(Lr - 1, Col - 1).Offset(, 1) .Borders.LineStyle = 1: .Font.Bold = True .InsertIndent 1: Columns.AutoFit .SpecialCells(2).Interior.ColorIndex = 35 End With Set mon_range = Nothing Set fin_rg = Nothing Application.ScreenUpdating = True '=============================== End Sub الملف مرفق sep_complex_names_New.xlsm

بقي عليك ان تضغط رز أفضل اجابة(على المشاركة الاخيرة) لاغلاق الموضوع

انظر الى المشاركة الاخيرة هناك تفاصيل اكثر حيث يقوم الكود بوضع كل نطاق من الــ Range في سطر مستقل داخل الــــ MsgBox لحسن قرائته

تحديث بسيط على الكود و فعاليته Option Explicit Sub select_my_special_range() Dim z%, y#, x#, i# Dim Lr%: Lr = Cells(Rows.Count, "F").End(3).Row Dim My_min#: My_min = Application.Min([b2:c2]) Dim My_max#: My_max = Application.Max([b2:c2]) [c2] = My_max: [b2] = My_min If My_max > Lr Then _ My_max = Lr: [c2] = My_max If My_min > Lr Then _ My_min = 1: [b2] = My_min Dim my_rg As Range Range("f1:f" & Lr).Interior.ColorIndex = xlNone i = My_min Do While i < My_max + 1 On Error Resume Next x = 1 / Range("f" & i) y = Range("f" & i) + 1 z = IsEmpty(Range("f" & i)) On Error GoTo 0 If x + y + z <> 0 Then If my_rg Is Nothing Then Set my_rg = Range("f" & i) Else Set my_rg = Union(my_rg, Range("f" & i)) End If End If i = i + 1 x = 0: y = 0 Loop my_rg.Select my_rg.Interior.ColorIndex = 6 MsgBox "YOUR RANGE IS :" & Chr(10) & _ Join(Split(my_rg.Address, ","), Chr(10)) End Sub الملف من جديد select_numeric_new.xlsm

حيث انك لم ترفع ملفاً للمعاينة قمت بتصميم ملف يتناول ما تريد (مع حرية اختيار البداية وانهاية) Option Explicit Sub select_my_special_range() Dim z%, y#, x#, i# Dim Lr%: Lr = Cells(Rows.Count, "F").End(3).Row Dim My_min#: My_min = Application.Min([b2:c2]) Dim My_max#: My_max = Application.Max([b2:c2]) If My_max > Lr Then _ My_max = Lr: [c2] = My_max If My_min > Lr Then _ My_min = 1: [c2] = My_min Dim my_rg As Range Range("f1:f" & Lr).Interior.ColorIndex = xlNone i = My_min Do While i < My_max + 1 On Error Resume Next x = 1 / Range("f" & i) y = Range("f" & i) + 1 z = IsEmpty(Range("f" & i)) On Error GoTo 0 If x + y + z <> 0 Then If my_rg Is Nothing Then Set my_rg = Range("f" & i) Else Set my_rg = Union(my_rg, Range("f" & i)) End If End If i = i + 1 x = 0: y = 0 Loop my_rg.Select my_rg.Interior.ColorIndex = 6 MsgBox "YOUR RANGE IS :" & Chr(10) & my_rg.Address End Sub الملف مرفق select_numeric.xlsm

ربما الشرح في الملف المرفق يوضح كيفية كتابة الوقت و تمييزه عن الرقم في اكسل Number To Time.xlsx

ضع النقطة في المكان حيث الخطأ في الكود بين الكلمتين ( sNomFichier و PDF) sNomFichierPDF sNomFichier.PDF