مختار حسين محمود

أخى صلاح أخى الشيبانى بارك الله فيكما تقبلا تحياتى

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

Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, Range("I4:N11")) Is Nothing Then Target = Format(Now, "dd-mm-yyyy") End Sub أخى الشيبانى تحياتى

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

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

رووووووووووووووووووووووح يا شيخ منك لـ اللى كلت دراع جوزها

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

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

ادراج التاريخ من خلال وضع الماوس على الخلية.rar أخى العزيز عبدالعزيز بارك الله فيك أخى الكريم على تشجيك المستمر و تشرفت بمرورك أستاذنا الفاضل محمد حسن بارك الله فيك على تشجيك المستمر وتشرفت بمرورك أخى فارس التاريخ يتغير كلما نقرت على الخلية حدث الورقة : اعمل كليك يمين على اسم الورقة أو الشيت ستجد كلمة View code اضغط عليه هتلاقى نافذة محرر الاكواد للورقة أمامك

جرب 2 تنسيق شرطي للصف.rar

Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, Range("I4:N11")) Is Nothing Then Target = Format(Now) End Sub ضع الكود السابق فى حدث الورقة ثم احفظ الملف بصيغة XLS أو XLSM

عمل مبارك بإذن الله أخى سعد تحياتى وبالتوفيق فى باقى المشروع بارك الله فيك أخى العيدروس حزاك الله خيرا تحياتى لشخصكم الكريم

ما شاء الله عليك رائع أخى الكريم جعل فى ميزان حسناتك

أخى العيدروس عمل رائع بارك الله فيك بس فيه ملحوظتين جربت ادخال التاريخين من 1/11/2015 الى 10/11/2015 وحدث الآتى اسم محمد تكرر فى هذه الفترة مرتين بينما يظهر فى الليبل أنه تكرر صفر لى طلب : تبدأ بالبيانات فى النتائج بالتاريخ ثم الباقى ثم ثم أرجوا أن تظهر البيانات فى الفورم كالتالى : رقم العميل اسم العميل كود الصنف ......وهكذا تحياتى

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

نعم مكرر مع الاختلاف أنا وضعت الحل هنا ثم تصادف أن المطلوب هناك مشابه تماما للموضوع هنا وتدخلت هناك بالتعديل على الحل الذى قدمه أخونا مصطفى. تحياتى

أخى الحبيب خيال تم تلبية طلبك دالة للجمع والتلوين على الرابط http://www.officena.net/ib/topic/65138-%D8%B9%D9%85%D9%84-%D8%AF%D8%A7%D9%84%D8%A9-%D8%AA%D9%82%D9%88%D9%85-%D8%A8%D8%A7%D9%84%D8%AC%D9%85%D8%B9-%D9%88%D8%AA%D9%84%D9%88%D9%8A%D9%86-%D8%A7%D9%84%D8%AE%D9%84%D9%8A%D8%A9-%D8%B9%D9%86%D8%AF-%D8%B1%D9%82%D9%85-%D9%85%D8%B9%D9%8A%D9%86/ أخى الحبيب مصطفى بارك الله فيك حللك جميل بس فيه ملاحظات استخدام نفس التنسيق الشرطى مرة على العمود E ومرة على العمود H فالأحرى تطبيق التنسيق على النطاقين مرة واحدة طالما لهما نفس التنسيق يعنى فى خانة appliese to نضع $H$6:$H$80;$E$6:$E$80= يوجد قيم خاطئة فى نتائج المعادلة بالعمودين E و H لأن فيه قيم نصية فى آخر العمودين لذلك تم اضافة الدالة IFERROR و اضافة تنسيق جديد والتعديلات فى المرفق المقارنة++++++.rar

أخى الكريم أولا تم تحويل النطاق d6:d15 من عدد عشرى الى عدد صحيح تم استخدام الدالة ABS لتحويل النتائج السالبة إلى موجبة تم استخدام التنسيق الشرطى كالتالى : حدد نطاق التنسيق و من التنسيق الشرطي اختر New Rule ثم اختر الخيار الأخير ...... use a formula فى خانة المعادلة ضع المعادلة D6>C6= و على تنسيق Format واختر اللون المناسب ( أخضر ) كرر العملية السابقة مع تغيير المعادلة الى D6<C6= و على تنسيق Format واختر اللون المناسب ( احمر ) كرر العملية السابقة مع تغيير المعادلة الى D6=C6= و على تنسيق Format واختر اللون المناسب ( برتقالى ) لا تنسى تحديد نطاق التنسيق فى كل مرة . اطلع على المرفق التالى مقارنة 2.rar مقارنة 2.rar

تمام كده أنا كنت بأجرب على مجموعة من الملفات دون غيرها لا يظهر معها هذا الخطأ ولهذا ذكرت أن الكود ليس به أخطاء خاصة و أن النتائج النهائية صحيحة 100 % نحن الآن بانتظار رأى أبو يوسف فى المرفق الأخير يا رب يكون مرضى وصل لمبتغاه

أخى أبو يوسف أنا مجرب الملف قبلك عدة مرات و لا تظهر لى هذه الرسالة تخلص من جميع المرفقات المقدمة منى أو من أستاذنا ياسر و تأكد من عدم وجود ملفات اكسل بنفس الاسم وجرب المرفق الأخير فى مشاركتى الأخيرة Collect Data From Multiple CSV Workbooks YasserKhalilMokhtar V 4.rar

أخى وأستاذى الغالى بارك الله فيك . اكتشفت خطأ فى المعادلة SUMPRODUCT و تم التصحيح أخى أبو يوسف المرفق التالى لحساب عدد التكرار لكل مكتب في جميع الاوراق هذا المرفق به كودين يتم استدعائهما بزر واحد اذا كنت تريد استدعاء كل كود على حده كما طلبت فى مشاركتك الأخيرة يمكنك التعديل بسهولة كالتالى السطر التالى فى الكود الاول يحذف Call CopyToNewSheet أضف شكلا تلقائيا أو زر و اربطه بالكود الثانى وأى ملاحظات أخرى فأهلا و سهلا بها فلا تخجل تحياتى لك ولأخى وأستاذى أبا البراء Collect Data From Multiple CSV Workbooks YasserKhalilMokhtar V 4.rar

بارك الله فيك أستاذ أحمد تشرفنا بمرورك الكريم

السلام عليكم ورحمة الله وبركاته أخى أبو يوسف جرب هذا الكود حساب عدد التكرار لكل مكتب في جميع الاوراق و أبدى ملاحظاتك Option Explicit Sub CopyToNewSheet() ' by Mokhtar Hussien ' 25/11/2015 Dim SH As Worksheet Dim P As Long Dim Rng As Range Dim Data, ColFound Dim Obj As Object Application.ScreenUpdating = False Application.DisplayAlerts = False '----------------------------------------------------------------- Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "التجميعى" '----------------------------------------------------------------- For Each SH In ThisWorkbook.Sheets If IsError(Application.Match(SH.Name, Array("Master", "التجميعى"), 0)) Then SH.Range("M2").CurrentRegion.Offset(1).Copy With Sheets("التجميعى") .Activate .Range("B1:C1") = Array("مكتب التربية", "العدد") .Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteAll With .Range("B1").CurrentRegion .Range("A1:B1").Interior.Color = vbYellow .Borders.Weight = xlThin .BorderAround Weight:=xlThick .Columns.AutoFit End With End With End If Next '----------------------------------------------------------------- With Sheets("التجميعى") ColFound = Application.Match("*مكتب التربية*", .Rows(1), 0) If IsNumeric(ColFound) Then .Range("G2:H2") = Array("الاحصاء النهائى لمكاتب التربية", "الجملة") Set Rng = .Range(.Cells(2, ColFound), .Cells(.Cells(Rows.Count, ColFound).End(xlUp).Row, ColFound)) Set Obj = CreateObject("scripting.dictionary") Data = Rng For P = 1 To UBound(Data) Obj(Data(P, 1) & "") = "" Next .Range("G3:G1000").ClearContents .Range("G3").Resize(Obj.Count, 1) = Application.Transpose(Obj.keys) '----------------------------------------------------------------- With .Range("H3:H" & .Cells(Rows.Count, "G").End(xlUp).Row) .Formula = "=SUMPRODUCT( (R2C2:R1000C2 =RC[-1]) * R2C3:R1000C3 )*2" .Value = .Value End With '----------------------------------------------------------------- With .Range("G2").CurrentRegion .Borders.Weight = xlThin .BorderAround Weight:=xlThick .Columns.AutoFit .Range("A1:B1").Interior.Color = vbYellow End With '----------------------------------------------------------------- .Columns("A:F").Delete Shift:=xlToLeft '----------------------------------------------------------------- End If End With '----------------------------------------------------------------- Sheets("Master").Activate Application.CutCopyMode = False Application.ScreenUpdating = True Application.DisplayAlerts = False End Sub أخى و أستاذى ياسر راجع هذا الكود و ان كان يحتاج لتحسينات فتفضل مشكورا تحياتى Collect Data From Multiple CSV Workbooks Yasser Mokhtar final.rar

أخي الكريم أبو يوسف أنا فى انتظار شكل المخرجات بالنسبة للورقة التجميعية واسم الورقة

جميله جدا أخى ياسر بارك الله فيك