سليم حاصبيا

ضع الكود في الملف و قم بتنفيذه و اعلمني بالنتيحة

دائماً يلزم بيانات لتجربة الكود فليس من المعقول ان يقوم احد بتعبئة عدة أعمدة(6) في 50 صف اي اكثر من 300 رقم لاجراء اختبار كود عنك على كل حال جرب هذا الكود Option Explicit Sub talween() Dim my_rg As Range, CEl As Range Set my_rg = Range("AE9:AJ59") my_rg.Interior.ColorIndex = 0 Dim my_colore As Byte For Each CEl In my_rg If IsNumeric(CEl) Then Select Case CEl.Value Case Is < 15000: my_colore = 0 Case Is <= 50000: my_colore = 19 Case Is <= 75000: my_colore = 6 Case Is <= 100000: my_colore = 44 Case Else: my_colore = 3 End Select CEl.Interior.ColorIndex = my_colore End If Next End Sub

تم التعديل كما تريد الورقة Salim من هذا الملف Choose_Winner.xlsm

حيث انك لم ترفع ملفاً للمعالجة اليك هذا النموذج Rand_Genarator.xlsm

جرب هذا الكود Option Explicit Private Sub Worksheet_Activate() data_val1 End Sub '================================== Private Sub ComboBox2_Change() ComboBox1.Clear Dim I% I = 4 With Sheets("العقود") Do Until .Cells(I, "c") = vbNullString If .Cells(I, "c") = ComboBox2.Value Then ComboBox1.AddItem .Cells(I, "d") End If I = I + 1 Loop End With End Sub '==================================== Sub data_val1() Dim I%: I = 4 Dim arr Dim rg As Object Set rg = CreateObject("system.collections.arraylist") With rg Do Until Sheets("العقود").Range("c" & I) = vbNullString If Not .contains(Sheets("العقود").Range("c" & I).Value) Then .Add Sheets("العقود").Range("c" & I).Value I = I + 1 Loop .Sort arr = .toarray End With Sheets("كشف عميل").OLEObjects("Combobox2").Object.List = Application.Transpose(arr) End Sub الملف مرفق AouKoud_22.xlsm

يرجى ارفاق الملف للمالجة ومحاولة الحل

See this video https://www.youtube.com/watch?v=NyyQ8WcM8_w

البرنامح يعمل حتى الصف 45 (ويمكن الزيادة اذا اردت وذلك بنسخ المعادلات الى اي عدد من الصفوف) اكتب فقط في الصفحة الرئيسية اسم الطالب وعلاماته وسوف تنتقل مباشرة الى حيث تريد

هذه المعادلة المطلوبة =A2&" "&B2

جرب هذا الملف Std_6.xlsx

تم التعديل _salim_days.xlsx

أو هذا مثلاً لاختيار اي شيء ( من القائمة في L2 المنسدلة لإخفائه) في حال اضافة بيانات مختلفة عن "تم" او "-" في العامود J يرجى تشغيل الماكرو quelque chose أولاً للحصول على تحديث القائمة المنسدلة Option Explicit Sub Hid_rows() With Application .ScreenUpdating = False .EnableEvents = False End With quelque_chose Dim S_sh As Worksheet: Set S_sh = Sheets("ورقة1") With S_sh Dim My_Table As Range: Set My_Table = .Range("b2").CurrentRegion .Range("m2").Formula = "=$J3<>$L$2" My_Table.AdvancedFilter Action:=1, CriteriaRange:=.Range("M1:M2") .Range("M2").ClearContents End With With Application .ScreenUpdating = True .EnableEvents = True End With End Sub '========================================= Sub SHOW_ALL() With Application .ScreenUpdating = False .EnableEvents = False End With On Error Resume Next Sheets("ورقة1").ShowAllData On Error GoTo 0 With Application .ScreenUpdating = True .EnableEvents = True End With End Sub '====================================== Sub quelque_chose() With Sheets("ورقة1") Dim i%: i = 3 Dim arr Dim rg As Object Set rg = CreateObject("system.collections.arraylist") With rg Do Until Range("j" & i) = vbNullString If Not .contains(Range("j" & i).Value) Then .Add Range("J" & i).Value i = i + 1 Loop .Sort arr = .toarray arr = Join(arr, ",") End With With .Range("L2").Validation .Delete .Add xlValidateList, Formula1:=arr End With End With End Sub FILE HERE ايتام دار البر by_CHOOSE_filter.xlsm

زيادة في اثراء الموضوع هذا الكود(اسرع بكثير) Option Explicit Sub Hid_rows() With Application .ScreenUpdating = False End With Dim S_sh As Worksheet: Set S_sh = Sheets("ورقة1") With S_sh .Range("R1") = "تم" Dim My_Table As Range: Set My_Table = .Range("b2").CurrentRegion .Range("m2").Formula = "=$J3<>$R$1" My_Table.AdvancedFilter Action:=1, CriteriaRange:=.Range("M1:M2") .Range("M2").ClearContents .Range("R1").ClearContents End With With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With End Sub '========================================= Sub SHOW_ALL() On Error Resume Next Sheets("ورقة1").ShowAllData On Error GoTo 0 End Sub الملف مرفق ايتام دار البر by_adv_filter.xlsm

مع انك لم ترفع ملفاً للمعاينة اليك هذا الملف كنموذج =IF(N(A1)<=0,"",CHOOSE((0.5-MOD(A1,1)<=0)+1,FLOOR(A1,1),CEILING(A1,1))) takrib.xlsx

تم التعديل نسخة_salim version2.xlsm

تم معالجة الامر نسخة_salim sw.xlsm

هذه المعادلة =CHOOSE(AND(A1=0,B1=0)+1,ABS(B1-A1)+1,0)

جرب هذا الملف نسخة_salim.xlsm

جرب هذا الملف _salimالقانونية.xlsx

جرب هذا الملف قروش وجنيهات Salim.xlsx

بعد اذن الاخ salimhebboul معادلة واحدة توضع في الخلية D13 وتسحب يميناً 3 أعمدة ونزولاً قدر ما تريد =MID($B13,4*(COLUMNS($D$13:D13)-1)+1,4)

جرب هذا الكود لا أعلم سبب الجحم الكبير لهذا الملف (اكثر من 5 ميغا) Option Explicit Sub Talween() With Sheets("sheet1") Dim s_rg As Range, r%, x, my_color% .Range("r:r").Interior.ColorIndex = 0 Set s_rg = .Range("r:r").Find("المتبقي") r = s_rg.Row x = r Do Select Case Cells(r + 1, "R") Case Is >= Cells(r + 1, "t") / 2 my_color = 4 Case Is = 0: my_color = 3 Case Is < Cells(r + 1, "t") / 2 my_color = 6 Case Else: my_color = 0 End Select Cells(r + 1, "R").Interior.ColorIndex = my_color Set s_rg = .Range("r:r").FindNext(s_rg) r = s_rg.Row If x = r Then Exit Do Loop End With End Sub الملف مرفق Talween.xlsm

أرجو ان تفهمني جيداً اسم: عبد الله عبد الرّحيم فتح الاسلام مثلا هو اسم ثلاثي في نظر الانسان (لكنه سداسي في نظر الاكسل لأنه يقوم بإحصاء المسافات الموجودة داخل ()Trim الاسم "5 " ويزيد واحد ليحصل على مجموع الكلمات لهذا الاسم "6") الاسم الاول: عبد الله اسم الاب: عبد الرّحيم الشهرة: فتح الاسلام فلو طلبنا من اكسل ايجاد الاسماء السداسية مثلاً قام بجلب من ضمن اللائحة عبد الله عبد الرّحيم فتح الاسلام (لأنه يتكوّن من 6 كلمات) ولكن لو طلبنا الاسماء الثلاثية فلا يمكن ايجاده

الاسماء هي كلمات تفصلها مسافة كبف يعرف الاكسل في الاسم المركب اذا كان الاسم الاول هو الكلمة الاولى والاسم الثّاني هو الكلمة الثّانية و ليس الكلمتين مع بعض هما الاسم الأول هذا مثال: نور الهدى يمكن ان يكون نور هو اسم الشخص و الهدى اسم عائلته او نور الهدى هو الاسم الاول الكامل لشخص واحد

المشكلة هنا في الاسمار المركبة مثلاً: فرج الله نجيب مرسي اسم ثلاثي لكن الاكسل يفهمه رباعي (مؤلف من 4 كلمات) سيف الاسلام محمد فضل الدين اسم ثلاثي لكن الاكسل يفهمه خماسي لذا يجب القيام باضافة عامود الى الجدول يحدد نوع الاسم (و تقوم بالفرز على اساسه) مثل هذا الملف Name_kind.xlsx