نجوم المشاركات

استعمل المعادلة التالية للتنسيق الشرطي =(D$26=MAX($D26:$O26))*(COUNTIF($D26:D26,D26)=1)=1

KhezzaiVisuFShape.rar

تواجهني كثير مشكلة وجود مسافات زائدة فى الكتابة سواء عند الكتابة او عند استلام ملفات من الغير و اغلب هذه المسافات تتمثل فيما يلي: - مسافة زائدة بعد حرف الواو - مسافة زائدة قبل الفاصلة - مسافتين متتاليتين مما يضيع الكثير من الوقت فى تصحيح الوضع لذا استخدم حاليا هذا الكود للتغلب على هذه المشكلة. نظرا لكثرة استخدامه بالنسبة لي ، ووجد انه من الافضل اضافته الي شريط الوصول السريع quick access toolbar و ذلك عن طريق ما يلي: 1- نقل الكود الي الوحدات النمطية العامة الضغط بالزر الايمن على القائمة او شريط القوائم ثم اختيار Customize quick access bar و من ثم اختيار ماكرو من القائمة و اضافته ، ثم تغيير اسم الايقونة و شكلها للسهولة Sub ArabicSpace() ' حذف المسافة قبل الفاصبة Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = " ، " .Replacement.Text = "، " .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = False .MatchControl = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll ' حذف المسافة قبل حرف الواو Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = " و " .Replacement.Text = " و" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = False .MatchControl = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll ' استبدال المسافتين الزائدتين بواحدة فقط Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = " " .Replacement.Text = " " .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = False .MatchControl = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll End Sub

تجربة متواضعة مني لأعضاء المنتدى الرائعين. وهي عبارة عن فورم لطباعة تقرير من أي شيت وفلترة النتائج في صفحة جديدة.. إليكم المرفق وابانتظار ملاحظاتكم. استعلام.rar

المساعدة في فصل الناجحين عن الراسبين بالمعادلات فصل الناجحين والراسبين.rar

السلام عليكم ورحمة الله وبركاته قائمة منسدلة تعتمد على قائمة منسدلة اخرى يمكن استعمال الدالة INDIRECT عن طريق النطاقات المسماة define name ولكن استخدمنا طريقة مختلفة في هذه الحالة اتمنى ان تفيد الجميع المعادلة المستخدمه فى القائمة المنسدلة =OFFSET($A$2;;MATCH($A$6;$A$1:$E$1;0)-1;COUNTA(INDEX($A$2:$E$4;;MATCH($A$6;$A$1:$E$1;0)));) تحميل ملف الاكسيل list.rar

أخي العزيز / عيد مصطفى قمت بعمل معادلة تؤدي إن شاء الله الغرض وأحببت أن أشارك بها لإثراء الموضوع لكنها لا ترقى إلى معادلة أستاذنا سليم حاصبيا حفظه الله ماشاء الله عليه قمة في التفكير ومعادلة مختصرة =AND(D$26=MAX($D$26:$O$26);(COUNTIF($D$26:D$26;MAX($D$26:$O$26))=1)) تحياتي لكم ولأستاذنا سليم حاصبيا

جرب هذا الماكرو Sub filter_me() lre = Cells(Rows.Count, 5).End(3).Row Range("e3:g" & lre).Copy Range("k3") Range("l4:m" & lre).SortSpecial , key1:=Range("m4"), order1:=xlDescending End Sub

الأخ الكريم محمد الخازمي اثراءاً للموضوع هذا حل آخر abo_abary_تلوين الجمعة والسبت.rar

معادلة فريدة لاستخلاص نتيجة الإستبيانات مهما كان عددها.. وهي من السهل الممتنع.. أترككم مع المثال. معادلة استبيان.rar

الأخ الكريم بوب2016 جرب الملف التالى انشاء الله يكون به المطلوب ولى طلب الرجاء طرح الطلبات الجديدة فى موضوع جديد ليستفيد منه الكل abo_abary_تصميم شيت معدل2.rar

فكرتي إليكم هي عمل كاشير للمبيعات بأزرار معرفة بصور الأصناف .. الفكرة طبعا غير مكتملة لكثرة تطرق كثير من الأعضاء بفورم الترحيل.. ولكن الهدف هي تغيير نمط التفكير والانطلاق بطريقة مميزة ومألوفة للمبيعات.. أترككم مع الملف. ملاحظة: لتعديل الكميات والحذف دبل كليك على الصنف. بانتظار آراءكم وتقبلوا تحياتي القلبية testcasheir.rar

جرب هذا الملف الجديد ربما يكون اسرع قليلاً ترتيب المجموع salim corriger.rar

r = r + k + 3 استبدل الرقم 3 بالرقم 2 قي هذا السطر تأكد من ذلك بوضع بعض البيانات الجديدة في العامود C

جرب هذا الملف ترتيب المجموع salim.rar

أخي العزيز / mesho263 جرب التعديل التالي Days_2.rar

الاخ حسين22 جرب المرفق Omar_2.rar

الموضوع سهل كل ما عليك تغير مسار البارتشن اللي محتاجه وحط INDEX بتاعك في اي مكان HYPERLINK.rar

السلام عليكم جرب هذه الطريقة المنصرف اليومي.rar

أخي الكريم عامر ياسر إثراءً للموضوع .. كنت قد قدمت من فترة موضوع بنفس الفكرة على الرابط التالي الرابط من هنا وقمت بعمل بعض التعديلات ليتناسب الكود مع ملفك .. إليك الكود التالي ويوضع في موديول عادي Sub SplitList() 'تعريف المتغيرات Dim shSource As Worksheet, shTarget As Worksheet Dim rList As Range, rListA As Range, rListB As Range Dim hCount As Long, tCount As Long Const colNum As Integer = 5 'عدد أعمدة النطاق المراد عمل إنشطار له 'تعيين ورقة العمل المصدر التي تحتوي القائمة الرئيسية وورقة العمل الهدف Set shSource = Sheets("البيانات") Set shTarget = Sheets("الناجحون") 'تعيين النطاق الذي يحتوي على القائمة المراد شطرها Set rList = shSource.Range("A5:A" & shSource.Cells(Rows.Count, "B").End(xlUp).Row) 'تعيين بداية النطاق للشطر الأول من القائمة Set rListA = shTarget.Range("A5") 'تعيين بداية النطاق للشطر الثاني من القائمة Set rListB = rListA.Offset(, colNum) 'تعيين قيمة المتغير ليساوي عدد خلايا النطاق المصدر tCount = rList.Cells.Count 'تعيين قيمة للمتغير ليساوي تقريب قيمة قسمة المتغير السابق ÷ 2 hCount = Round(tCount / 2, 0) 'مسح النطاق الذي ستظهر فيه النتائج للشطر الأول والشطر الثاني shTarget.Range("A4:J10000").ClearContents 'وضع نتائج الشطر الأول rListA.Resize(hCount, colNum).Value = Range(rList(1).Address(External:=True) & ":" & rList(hCount).Address(External:=True)).Resize(hCount, colNum).Value 'وضع نتائج الشطر الثاني rListB.Resize(tCount - hCount, colNum).Value = Range(rList(hCount + 1).Address(External:=True) & ":" & rList(tCount).Address(External:=True)).Resize(hCount, colNum).Value MsgBox "Done ..." & vbNewLine & "Best Regards" & Chr(10) & "YasserKhalil", 64 End Sub تقبل تحياتي

شكرا استاذ سليم حاصبيا جزاك الله خيرا ً على مساعدتنا في الاجابة وجعله الله في ميزان حسناتك شكرا والف شكر

جرب هذا الماكرو Dim Sh1 As Worksheet Dim Sh2 As Worksheet Dim My_num, Lr, m As Integer m = 5 Set Sh1 = Sheets("البيانات"): Set Sh2 = Sheets("الناجحون") Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Sh2.Range("A5:J500").ClearContents Sh1.Activate Lr = Application.Max(Sh1.Range("a2", Range("a" & Rows.Count).End(3))) My_num = Lr \ 2 + Lr Mod (2) Sh1.Range("a5").Resize(My_num, 6).Copy Sh2.Range("a" & m).PasteSpecial (xlValues) Application.CutCopyMode = False Sh1.Range("a5").Offset(My_num).Resize(Lr - My_num, 6).Copy Sh2.Range("f" & m).PasteSpecial (xlValues) Sh2.Select Sh2.Range("a5").Select Sh1.Select Sh1.Range("a5").Select Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub

الأخ الكريم عامر ياسر بعد السلام عليكم جرب المرفق التالى abo_abary_ترحيل البيانات نصفين متساويين.rar

شاهد هذين الفديو هين

أخي الفاضل الدهشوري إليك حل بالأكواد (رغم أنك طلبت أن يكون بالمعادلات) .. لعل وعسى أن يكون المطلوب .. وأنا شخصياً أفضل التعامل بالأكواد Sub ExtractData() Dim arrData, arrOut(1 To 1000, 1 To 5), I As Long, P As Long, D1 As Date, D2 As Date, isQualified As Boolean D1 = ورقة2.Range("E2").Value D2 = ورقة2.Range("H2").Value With ورقة1 arrData = .Range("A1:H" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value For I = 1 To UBound(arrData, 1) If arrData(I, 1) = "التاريخ:" Then If arrData(I, 2) >= D1 And arrData(I, 2) <= D2 Then P = P + 1 arrOut(P, 1) = arrData(I, 7) arrOut(P, 5) = arrData(I, 2) isQualified = True Else isQualified = False End If End If If arrData(I, 1) = "إجمالى" And isQualified Then arrOut(P, 2) = arrData(I, 2) Next I End With ورقة2.Range("B5").Resize(UBound(arrOut, 1), UBound(arrOut, 2)).Value = arrOut End Sub تقبل تحياتي كشف حساب.rar

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

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

ملف شئون طلبه ابتدائى

أخي العزيز / أبو حنين إضافة إلى حلول الأخوة الكرام لأستاذ :القبطان و الأستاذ : عبد الله بولنوار جزاهما الله خير و لا ننسى أستاذنا القدير / ياسر خليل جزاه الله خير هذاحل بواسطة هذه المعادلة توضع في التنسيق الشرطي وهي =TEXT(DATE($G$1;COUNTIF($H$2:H$2;1)+1;H$2);"ddd")="السبت" على أساس أن البداية تكون من شهر يناير حتى لم يوضع رقم الشهر في الصف الأول السبت 1.rar

الأخ العزيز / أبو حنين وبعد إذن أستاذنا الكبير ياسر خليل حفظه الله هذا حل آخر قم بإعداده لإثراء الموضوع تحدد فيه السنة وكذلك الشهر هو لشهر واحد فقط السبت.rar

القديم المتجدد .. تطبيق إكسيل لإدارة المصروفات في صفحة واحدة عن طريق المعادلات.. أتمنى أن يحوز رضاكمِ.ِ ميزانية مصروفات.rar

فكرة جميلة لمتابعة تجديد الوثائق لديك، كل ما عليك هو أن تدخل التاريخ ودع الإكسيل يكتشف تجديداتك خلال 30 يوم القادمة.. أتمنى أنني قدمت شيئا مفيدا لكم. expired date.rar

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