سليم حاصبيا

=VLOOKUP(MAX(IF($A$2:$A$100<=$E$2,$A$2:$A$100,0)),$A$2:$B$100,2) استعمل هذه المعادلة مع Ctrl+Shift+Enter و ليس Enter , وحدها اذا لم تعمل معك المعادلة استبدل الفاصلة "," بفاصلة منقوطة ";" (حسب اعدادات الجهاز عندك) لتصبح هكذا =VLOOKUP(MAX(IF($A$2:$A$100<=$E$2;$A$2:$A$100;0));$A$2:$B$100;2)

هذا الكود يمنع التعديل في الخلايا الني تحتوي على معادلات اذا اضفت اي معادلة الى الصفحة في اي خلية يطبق عليها الكود الكود (يوضع في جدث الصفحة المعنية وليس في موديل مستقل) Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) Application.EnableEvents = False With Me .Unprotect .Cells.Locked = False With .Cells.SpecialCells(-4123, 23) .Locked = True .FormulaHidden = True End With .Protect End With Application.EnableEvents = True End Sub الملف مرفق Protect_Formula.rar

كيف نختار اعداداً عشوائية بين عددين (كل الارقام او بعضها حسب المطلوب) دون ماكرو و دون تكرار (فقط معادلات) مع التنبيه في حال اخترت عدد الارقام المطلوبة اكثر من الفرق بين الحد الاقصى والحد الادنى من هذين العددين كل هذا في الملف المرفق Randbetween_without repetition with Formula.rar

انسخ هذه المعادلة الى الخلية D6 استعمل Ctrl+Shift+Enter , وليس Enter ,وحدها ثم اسحب الى باقي الخلايا لا تنس تنسيق الخلايا في العامود D الى تاريخ =IFERROR(INDIRECT("'"&A6&"'!C"&MAX(--(INDIRECT("'"&$A6&"'!$C$1:$C$100")<>"")*(ROW($C$1:$C$100)))),"")

ربما كان المطلوب Salimحسب 4الحالة.rar

لا اعلم بالضبط اذا كان هذا المطلوب Classeur salim Modifiee.rar

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

مجرد ما تحذف محنويات الخلية C او تكتب فيها اي شيء غير الكلمات الثلاث يتغير اللون الى الابيض

الكود المطلوب لاي حالة Option Explicit Sub Tarhil_Salim_Modifier2() Dim S_S As Worksheet Dim lr%, lr1%, i%, k%, m% Dim Off_col%, Int_Col%, My_Col% Set S_S = Sheets("البيانات") lr = S_S.Cells(Rows.Count, 1).End(3).Row My_Col = S_S.Cells(1, 3) Int_Col = Application.Match("الاسم", S_S.Range("a2:xfd2"), 0) Off_col = Application.Match("الحالة", S_S.Range("a2:xfd2"), 0) If Not IsNumeric(My_Col) Or My_Col < 2 Then Exit Sub My_Col = Int(My_Col) For i = 2 To Sheets.Count Sheets(i).Cells.Clear Next For i = 2 To Sheets.Count S_S.Cells(2, Int_Col).Copy Sheets(i).Cells(2, 1) S_S.Cells(2, Off_col).Copy Sheets(i).Cells(2, My_Col) Next For i = 2 To Sheets.Count k = 3 m = 3 Do Until S_S.Cells(2, Int_Col).Offset(k - 3) = "" If S_S.Cells(k, Off_col) = Sheets(i).Name Then Sheets(i).Cells(m, 1) = S_S.Cells(k, Int_Col) Sheets(i).Cells(m, My_Col) = S_S.Cells(k, Off_col) m = m + 1 End If k = k + 1 Loop Sheets(i).Columns(My_Col).AutoFit Next End Sub Private Sub CommandButton1_Click() Tarhil_Salim_Modifier2 End Sub Salimحسب 3الحالة.rar الملف مرفق

جسب الكود يحب ان تبدأ الاسماء من الخلية A3 والحالة في اي عامود اخر ( اذا اردت يمكن تغيير الكود ليبدأ ابنما تريد)

ريما كان المطلوب Classeur salim.rar

نم التعديل على الماكرو حسب الطلب Option Explicit Sub Tarhil_Salim_Modifier() Dim S_S As Worksheet Dim lr%, lr1%, i%, k%, my_col%, m% Dim Opt_col% Set S_S = Sheets("البيانات") lr = S_S.Cells(Rows.Count, 1).End(3).Row my_col = S_S.Cells(1, 3) Opt_col = Application.Match("الحالة", S_S.Range("a2:xfd2"), 0) If Not IsNumeric(my_col) Or my_col < 2 Then Exit Sub my_col = Int(my_col) For i = 2 To Sheets.Count Sheets(i).Cells.Clear Next For i = 2 To Sheets.Count S_S.Cells(2, 1).Copy Sheets(i).Cells(2, 1) S_S.Cells(2, Opt_col).Copy Sheets(i).Cells(2, my_col) Next For i = 2 To Sheets.Count k = 3 m = 3 Do Until S_S.Range("a" & k) = "" If S_S.Cells(k, Opt_col) = Sheets(i).Name Then Sheets(i).Cells(m, 1) = S_S.Cells(k, 1) Sheets(i).Cells(m, my_col) = S_S.Cells(k, Opt_col) m = m + 1 End If k = k + 1 Loop Sheets(i).Columns(my_col).AutoFit Next End Sub Private Sub CommandButton1_Click() Tarhil_Salim_Modifier End Sub الملف مرفق Salimحسب 2الحالة.rar

المعادلات لا تقوم بالتنسيق

الملف جاهز للعمل الكومبو يأخذ لائحته من العامود A اوتوماتيكياً (دون تكرار حتى اذا تم اضافة اسماء جديدة أو مكررة) جمع salim.rar

ربما ينفع هذا الكود Private Sub Worksheet_Change(ByVal Target As Range) With Application .EnableEvents = False .ScreenUpdating = False End With If Target.Column <> 1 Then With Application Application.EnableEvents = True Application.ScreenUpdating = True End With Exit Sub End If '============================ Range("d:d").Clear Range("a1:a" & Cells(Rows.Count, 1).End(3).Row).Copy Range("D1").PasteSpecial Paste:=xlPasteAllUsingSourceTheme Application.CutCopyMode = False Range("a" & Cells(Rows.Count, 1).End(3).Row).Select '============================== With Application Application.EnableEvents = True Application.ScreenUpdating = True End With End Sub

الملف مرفق salimمجموع.rar

نسخ هذه المعادلة الى C3 استعملها مع (Ctrl+Shift+Enter) ثم اسحبها الى باقي الخلايا =SUM(IF(ورقة1!$C$6:$C$500<>"",IF(ورقة1!$C$6:$C$500=C$2,IF(ورقة1!$B$6:$B$500=$B3,ورقة1!$D$6:$D$500),0)))

جرب هذا الملف Salimحسب الحالة.rar

انسخ هذه المعادلة الى C2 استعملها مع (Ctrl+Shift+Enter) ثم اسحبها الى باقي الخلايا =SUM(IF(ورقة1!$B$6:$B$500=$B2,ورقة1!C$6:C$500,0))

تفصل الملف بدون اعمدة مخفية salim1مرتبات-على.rar

نساعدك على ايه

هذه المعادلة في C2 ثم اسحب يساراً و نزولاُ =SUMPRODUCT((ورقة1!$C$6:$C$155=C$1)*(ورقة1!$B$6:$B$155=$B2))

شاهد الرد على هذا العنوان

جرب هذا الملف تم اخفاء يعض الاعمدة لسهولة الرؤية(يمكنك اعادة اظهارها) كما يمكنك تغيير القيم في الجدول (بالون الاصفر) salimمرتبات-على.rar

الملف جاهز ولكن يتطلب كودات جديدة لليوزر فورم الجديد Double_UserForm.rar