الخالدي

السلام عليكم ورحمة الله وبركاته الاخ الحبيب عبدالله باقشير الاخت الكريمة أم عبد الله احسن الله اليكم وجزاكم الخير الاخ محمود عبدالعزيز الحل في ملفي السابق كان على اساس الملف في المشاركة رقم 21 ربما الاختلاف في اسم الحسابات و المبالغ يستحسن ان ترفق مثال على نفس ملفك - ليس ملف مشابه - وذلك بعد ادخال عدد من الحسابات في اليومية ثم عمل كشف الحساب يدويا وباذن الله سيتكفل الاخوة بعمل نفس الكشف بالمعادلات في امان الله

السلام عليكم ورحمة الله وبركاته بارك الله بالأخوة الكرام المطلوب غير واضح في المرفق حل لعله قريب من المطلوب في امان الله كشف حساب بالدوال6.rar

السلام عليكم ورحمة الله وبركاته جزاك الله خيرا اخي الاستاذ/ عبدالله باقشير للفائدة ادخال شرط في المعادلة في حال تكرار الشرط لنفس الطالب =SUMPRODUCT(--(($B$5:$B$8<$B$4)+($C$5:$C$8<$C$4)+($B$5:$B$8="غ")>0)) في امان الله

السلام عليكم ورحمة الله وبركاته بارك الله فيك اخي الاستاذ / احمد عبد الناصر حل جميل وموفق لم اعد اشاهد لك مشاركات في الفترة الاخيرة ارجو ان يكون السبب تواجدي المحدود بالمنتدى نسال الله لك دوام الصحة والعافية ان يكون المانع خير هنا تعديل بسيط في الحل ليتوافق مع ملاحظة الاخ/ نور وحيد ارجو ان يكون المطلوب في امان الله جرد+++.rar

السلام عليكم ورحمة الله وبركاته هنا كود اخر ربما يكون مفيد في المعادلات الكود التالي يقوم بتلوين المعادلات في العمود H والمرتبطة بالخلية D5 والكود يلون المعادلات المرتبطة بشكل مباشر بلون و لون اخر مختلف للمعادلات المرتبطة بشكل غير مباشر(غير مباشر مثلا المعادلة مرتبطة بخلية اخرى والخلية الاخرى مرتبطة بالخلية D5) Sub ALKHALEDI_ارتباط_المعادلات() Application.ScreenUpdating = False Dim Rn As Range, C As Range Set Rn = Range([H6], Cells(Rows.Count, "H").End(xlUp)) Rn.Interior.ColorIndex = 0 On Error Resume Next Intersect(Rn, Range("D5").DirectDependents).Interior.ColorIndex = 3 For Each C In Intersect(Rn, Range("D5").Dependents) If Intersect(C, Intersect(Rn, Range("D5").DirectDependents)) Is Nothing Then C.Interior.ColorIndex = 4 Next Set Rn = Nothing Application.ScreenUpdating = True End Sub ايضا وللفائدة الكود التالي يلون خلايا التحقق من الصحة في العمود H ويلون كل مجموعة تحقق متشابه بلون مختلف عن مجموعات التحقق الاخرى ويمكن استخدام الكود مع خلايا التنسيق الشرطي بعد تغير الخاصة في الكود من التحقق من الصحة الى خاصية التنسيق الشرطي Sub ALKHALEDI_اختلافات_التحقق_من_الصحة() Dim Rn As Range, RnA As Range, RnS As Range, Rnx As Range, C As Range Dim Cr As Byte Set Rn = [H:H] Rn.Interior.ColorIndex = 0 On Error Resume Next Set RnA = Intersect(Rn, Cells.SpecialCells(xlCellTypeAllValidation)) Set RnS = Intersect(RnA, RnA.SpecialCells(xlCellTypeSameValidation)) RnS.Interior.ColorIndex = 3 For Each C In RnA If Intersect(C, RnS) Is Nothing Then Cr = Cr + 1 Set Rnx = Intersect(RnA, C.SpecialCells(xlCellTypeSameValidation)) Rnx.Interior.ColorIndex = Cr + 3 Set RnS = Union(RnS, Rnx) End If Next Set Rn = Nothing: Set RnA = Nothing: Set RnS = Nothing: Set Rnx = Nothing End Sub في امان الله

السلام عليكم ورحمة الله وبركاته عذارا لتأخر الرد عليك اخي الكريم/ فضل لتحقيق طلبك في اخر مشاركة اعرض عليك تعديلات يمكن ان تعملها على الكود السابق في مشاركتي الاخيرة لتختار منها ما يناسبك لتلوين اختلاف المعادلات بدون ان يشمل التلوين اخطأ المعادلات عدل في الكود السابق الامر التالي Set Rn = Rn.SpecialCells(xlCellTypeFormulas, 23) عدل الرقم 23 الى رقم 7 بحيث يكون الامر بعد التعديل كالتالي Set Rn = Rn.SpecialCells(xlCellTypeFormulas, 7) واذا ترغب في ان يكون تلوين اختلاف المعادلات (كل الاختلافات عن اول معادلة) بلون واحد بدلا من تلوين كل اختلاف بلون مختلف . عدل في الكود السابق الاوامر التالية Set Rn = Rn.SpecialCells(xlCellTypeFormulas, 23) For Cr = 4 To 56 Set Rn = Rn.ColumnDifferences(Rn(1, 1)) Rn.Interior.ColorIndex = Cr Next عدلها الى امر واحد التالي Rn.SpecialCells(xlCellTypeFormulas, 7).Interior.ColorIndex = 4 بالنسبة لأخطأ المعادلات واذا ترغب في تلوين اخطأ المعادلات بلون مختلف عليك اضافة الامر التالي الى الكود السابق Rn.SpecialCells(xlCellTypeFormulas, 16).Interior.ColorIndex = 5 اما اذا ترغب بتلوين اخطأ المعادلات مع تلوين كل خطأ بلون مختلف عليك بدلا من اضافة الامر السابق اضافة الاوامر التالية الى الكود السابق For Each C In Rn.SpecialCells(xlCellTypeFormulas, 16) C.Interior.ColorIndex = 5 + Application.Evaluate("ERROR.TYPE(" & C.Address & ")") Next ارجو ان يكون المطلوب في امان الله

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

السلام عليكم ورحمة الله وبركاته أخي الحبيب والعزيز بن علية جزاك الله خيرا واتمنى لك تمام الصحة والعافية كما تعلم الاكسل عالم كبير لا يمكننا الالمام بكله تميز اختلاف المعادلات خاصية موجود بالاكسل اكتشفتها بالصدفة ويمكن الوصول اليها من اختيار اختلافات الصفوف او اختلافات الاعمدة في نافذة الانتقال الخاص والخاصية تميز بين اختلاف النصوص وفي حال كان هناك معادلات تميز بين المعادلات المختلفة وان كانت متشابة في النتائج . ولهذا السبب الكود السابق يعمل على الخلايا التي بها معادلات فقط حتى لا تختلط اختلافات النصوص مع اختلافات المعادلات وجهة نظرك عن الخلايا الفارغة ومنشأ اسبابها صحيحة ومهمة والكود التالي يعمل ايضا على تلوين الخلايا الفارغة Sub ALKHALEDI_اختلاف_المعادلات_والفراغات() Application.ScreenUpdating = False Dim Rn As Range, Cr As Byte Set Rn = Range([H6], Cells(Rows.Count, "H").End(xlUp)) Rn.Interior.ColorIndex = 0 'تلوين الخلايا الفارغة On Error Resume Next Rn.SpecialCells(xlCellTypeBlanks).Interior.ColorIndex = 3 On Error GoTo 0 'تهاية اوامر تلوين الخلايا الفارغة On Error GoTo Error: Set Rn = Rn.SpecialCells(xlCellTypeFormulas, 23) For Cr = 4 To 56 Set Rn = Rn.ColumnDifferences(Rn(1, 1)) Rn.Interior.ColorIndex = Cr Next Error: Set Rn = Nothing Application.ScreenUpdating = True End Sub في امان الله اختلاف المعادلات والفراغات.rar

السلام عليكم ورحمة الله وبركاته هنا محاولة للحل ارجو ان تنجح الكود المرفق يقوم بتلوين خلايا المعادلات المختلفة وكل مجموعة بلون Sub ALKHALEDI_اختلاف_المعادلات() Dim Rn As Range, Cr As Byte Set Rn = Intersect(Range([H6], Cells.SpecialCells(xlCellTypeLastCell)), [H:H]) Set Rn = Rn.SpecialCells(xlCellTypeFormulas, 23) Rn.Interior.ColorIndex = 0 On Error GoTo Error: For Cr = 3 To 56 Set Rn = Rn.ColumnDifferences(Rn(1, 1)) Rn.Interior.ColorIndex = Cr Next Error: Set Rn = Nothing End Sub ارجو ان يكون المطلوب في امان الله اختلاف المعادلات.rar

السلام عليكم ورحمة الله وبركاته جرب الكود التالي Sub Farz2() For Each S In Sheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5")) With Range(S.Cells(2, 1), S.Cells(S.Rows.Count, 1).End(xlUp)(1, 18)) .Sort .Cells(3), 1, .Cells(4), , 1 .Sort .Cells(1), 1, .Cells(2), , 1 End With Next End Sub في امان الله ترتيب2.rar

السلام عليكم ورحمة الله وبركاته حسب فهمي للمطلوب جرب الكود التالي Sub AL_KHALEDI() For Each C In Intersect([R2:Z10000], ActiveSheet.UsedRange) If C = "" Then If C.MergeArea.Cells(1).Address = C.Address Then If C.Column = C.MergeArea.Cells(1, 1).Offset(-1, 0).MergeArea.Cells(1, 1).Column Then C.Value = C.MergeArea.Cells(1, 1).Offset(-1, 0).MergeArea.Cells(1, 1).Value End If End If End If Next End Sub في امان الله تعبئة الخلايا الفارغة.rar

السلام عليكم ورحمة الله الاستاذ الفاضل / أبو حنين جزاكم الله خيرا كود ممتاز والكثير في حاجة اليه تقبل الله منا ومنكم صالح الاعمال لكم ابلغ التحية والتقدير

السلام عليكم ورحمة الله وبركاته الاستاذ / عبدالله باقشير الاستاذ / محمود_الشريف شكرا للمرور الكريم وجزاكم الله خيرا -------------------------- الفاضل/ نور وحيد جزاكم الله خيرا ولكم مثل دعائكم لي بالنسبة لأي للمعادلة اعتقد انها ستكون ثقيلة واقترح عليك استخدام نفس المعادلة مع كود يقوم بإرجاع نتيجة المعادلة عند الضغط على زر جرب المرفق مع مراعاة الانتباه الى تسمية النطاقات ارجو ان لا تتردد في طلب حل افضل فقد يكون لدى الاخوة حل افضل بالمعادلات او بالاكواد في امان الله جرد حسب تصنيف_كود.rar

السلام عليكم ورحمة الله وبركاته بارك الله فيك اخي الكريم خالد الرشيدى في المرفق حل باستخدام معادلة صفيف كنت عملت عليه قبل مشاهدة مشاركتك في المرفق تم اضافة جدول باسم Rng في الورقة ورقة التصنيف الجدول يبسط المعادلة المستخدمة إضافة الى انه يعطي مرونة اكثر لتحديد اسم الصنف عند الجرد واسمة عند البيع لغرض الخصم من كميات الصنف مع ذلك ربما المعادلة قد تكون ثقيلة على الملف اذا كان جدول الجرد كبيرا في امان الله جرد حسب تصنيف.rar

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

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

السلام عليكم ورحمة الله شكرا لك استاذ/ محمود_الشريف ولكم وافر الإحترام والتقدير

السلام عليكم ورحمة الله بارك الله فيك استاذ/ محمود_الشريف ولإثراء الموضوع الكود التالي يعرض الاسم في CommandBar Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Row > 1 And Not IsEmpty(Target(1)) And Not Intersect(Target(1), [D:D]) Is Nothing Then Dim C As String, F As Integer C = "الاسم غير موحود": F = 394 On Error Resume Next With Sheets("ورقة1") C = .[A:A].Cells(Application.Match(Target(1), .[B:B], 0)) End With If Err Then F = 923 With CommandBars.Add(Name:="Name_Code", Position:=msoBarPopup).Controls.Add(Type:=msoControlButton) .Caption = C: .FaceId = F End With Application.CommandBars("Name_Code").ShowPopup Application.CommandBars("Name_Code").Delete End If End Sub في امان الله ربط الكود بالاسم.rar

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

السلام عليكم ورحمة الله ما شاء الله استاذ عبدالله باقشير فكرة من روائع الفكر تقبل الله منا ومنكم صالح الاعمال

السلام عليكم ورحمة الله بارك الله فيك استاذ حمادة عمر ولإثراء الموضوع ايضا يمكن استخدام الكود التالي Private Sub Comb_Click() On Error Resume Next If Not [INDEX(Aj22:Aj3000,MATCH(AL1,Aj22:Aj3000,0),1)].Select Then MsgBox ("غيرموجود") End Sub في امان الله

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

الكود يقوم بالفرز من العمود B الى العمود J حسب ابجد هوز في العمود B بالنسبة للمعادلة جرب تغير مرجع الدالة من مرجع نسبي الى مرجع مطلق شاهد المرفق جدول تصفية المنح معدل جديد3.rar

بارك الله فيك اخي الكريم شكرا للمرور والثناء الطيب

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