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

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

السلام عليكم أعتقد أخى و أستاذى ياسر أن أخانا أبا يوسف تاه قبل منى و منك لذلك مش قادر يوضح المطلوب بسرعة وبايجاز لكن أعتقد أنه فى النهاية يريد الآتى : 1- جلب البيانات من المجلد وهذا ما تحقق ورضى به أخونا أبويوسف 2- حساب عدد تكرار كل مكتب تربية و تعليم فى كل شيت ثم تجميع التكرارات فى شيت مستقل مش كده يا أبو يوسف و لا أنا لسه فى البطاطا ؟!!!!!!!!!!!!!! شوف يابو يوسف ان كان الكلام ده يمشى الحال نكمل و الا قولنا نقف و نشوف سكة تانيه أخى ياسر خلى بالك معاى ( و أنا متأكد أنك معاى و ما بتفوتش ) كبداية لحساب عدد تكرار كل مكتب تربية وتعليم فى كل ورقة أنا عملت كود مبدئى دخلت بيه ( فقط ) فى كل الأوراق لكى أتأكد من وجود النص "مكتب التربية" فى الخلايا المتاحة فى الصف الاول هذا هو الكود Option Explicit Sub countf() Dim SH As Worksheet Dim C As Range, Rng As Range Application.ScreenUpdating = False For Each SH In ThisWorkbook.Sheets If SH.Name <> "Master" Then SH.Activate For Each C In ActiveSheet.Range(Range("A1"), Cells(1, Cells(1, Columns.Count).End(xlToLeft).Column)) If Not C.Find("*مكتب التربية*") Is Nothing Then C.Activate ' Set Rng = Range(ActiveCell, ActiveCell.End(xlDown)) Range("M1").Value = "مكتب التربية" Range("N1").Value = "العدد " End If Next C Next SH Application.ScreenUpdating = True End Sub اللى جاى بقى : تعديل الكود ده ليحسب عدد تكرار كل مكتب تربية وتعليم فى كل ورقة ثم ندمجه مع كود جلب البيانات ثم ندخل على مرحلة التجميع النهائية . مش كده اللى عايزه يا أبو يوسف و لا برضه أنا لسه فى البطاطا همتك معاى بقى أخى و أستاذى الغالى ياسر فى عمل CountIf فى الـــ vba أصلى ما عملتوش قبل كده تحياتى لكما

معلش يا أبا يوسف خلينا نمشى خطوة خطوة أنت فهمت دلوقتى أنك عايز تضيف المعادلات آليا بعد جمع البيانات ؟ وكمان عمود المكتب يختلف من مصنف لآخر . تمام كده ولا فيه حاجة تانى ؟

Sub AutoNumbering() ActiveCell = ActiveCelltiveCell NS: A = Application.InputBox("أدخل أول رقم فى السلسلة التى تريد إنشاؤها", "أول رقم") B = Application.InputBox("أدخل آخر رقم فى السلسلة التى تريد إنشاؤها", "آخر رقم") If A = False Or B = False Then Exit Sub ElseIf A = "" Or B = "" Then MsgBox "!تأكد من إدخال الأرقام بشكل صحيح", vbExclamation, "إدخال خاطئ" Else If [IV65536] = 1 Then ActiveCell = A Else: Columns(ActiveCell.Column).Rows(65536).End(xlUp).Select If ActiveCell = "" Then ActiveCell = A Else: ActiveCell.Offset(1, 0).Select Selection = A End If End If ActiveCell.DataSeries xlColumns, , , 1, B End If If Application.WorksheetFunction.CountA(Columns(ActiveCell.Column)) = 1 Then ActiveCell.ClearContents Beep If MsgBox("أول رقم فى السلسلة أكبر من آخر رقم ... هل تود إعادة المحاولة ؟", vbQuestion + vbYesNo, " إدخال خاطئ") = vbNo Then Exit Sub Else: GoTo NS End If End If Beep If MsgBox("هل تود إنشاء سلسلة رقمية أخرى ؟", vbYesNo + vbQuestion, "إنشاء سلسلة أخرى") = vbNo Then Exit Sub Else: GoTo NS End If End Sub حدد النطاق المراد دق السرى فيه بالماس ثم شغل الكود لتضع أول وآخر رقم فى المجموعة تحياتى

أخى ياسر بارك الله فيك جميل الملف ده وخاصة وإن فيه لينك أوفيسنا بس يبقى أجمل و أجمل لو تخلينا ندخل على حسابنا مباشرة وآليا بواسطة الكود بدون عمل تسجيل دخول و ادخال باسورد يدوى

ان شاء الله ما فيش تقصير كل ما هنالك مشاغل الحياة تطغى علينا المرفق التالى تم فيه جمع البيانات من المجلد كما تم حساب عدد تكرار كل مكتب تربية وتعليم بالمعادلات شوف الخطوة اللى جايه ايه Collect Data From Multiple CSV Workbooks Mokhtar V2.rar

أستاذى أبا البراء كمل الجميل و خلص على الموضوع اللى بقاله 3 أيام ده معلش معى مشوار ضرورى

أشكرك أخى و أستاذى الكبير ياسر خليل مشكور على التعديل اللى ما جاش على بالى ده

متأسف لم أشاهد مشاركتك الا بعد أن عدلت فى مشاركتى ملحوظة للحصول على نتائج جيدة اجعل كل الملفات بصيغة xlsx بلاش من csv الخطوة اللى جاية باذن الله سهلة وهى حساب عدد تكرار كل مكتب تربية وتعليم بعد أن تقرر : هل النتائج مرضية بعد تحويل كل ملفاتك الى صيغة xlsx أم لا ؟

رويدك أخى الكريم الصبر الصبر طلباتك متعددة وهذا ما ينفر الأخوة من تلبية طلبك الأفضل أن تضع طلبا واحدا ومحددا ثم تطلب طلبا آخر أو تعديلا جرب الملف ده أولا لتجميع البيانات من الملفات شغل الكود واختار مجلدك ( معلمين ) ثم حدد الملفات التى ترغب فيها ثم نستكمل الباقى بإذن الله تعالى سواء معا أو مع الأخوة الزملاء ----------------------- ملحوظة للحصول على نتائج جيدة اجعل كل الملفات بصيغة xlsx بلاش من csv تحياتى لك و لا تنسى تغير اسمك الى العربية Collect data from multiple workbooks by mokhtar v1.rar

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

السّلام عليكم و رحمة الله و بركاته أخى الغالى المهندس ياسر فتحى بارك الله فيك وجعل فى ميزان حسناتك ... الدال على الخير كفاعله

السلام عليكم ورحمة الله وبركاته لقد تناولت فى موضوعى السابق " إزالة أو إبقاء آثار التنسيق الشرطى " على الرابط التالى http://www.officena.net/ib/topic/64950-%D8%A5%D8%B2%D8%A7%D9%84%D8%A9-%D8%A3%D9%88-%D8%A5%D8%A8%D9%82%D8%A7%D8%A1-%D8%A2%D8%AB%D8%A7%D8%B1-%D8%A7%D9%84%D8%AA%D9%86%D8%B3%D9%8A%D9%82-%D8%A7%D9%84%D8%B4%D8%B1%D8%B7%D9%89/ كيفية ازالة التنسيق الشرطى و تبعاته من تنسيقات ... أو الابقاء على تلك التبعات والتنسيقات و تحويلها من تنسيقات شرطية الى تنسيقات عادية و اليوم بإذن الله تعالى أقدم لكم كودا بسيطا لكن يمكن أن تكون آثاره و نتائجه من وجهة نظرى المتواضعة جميلة و مبهرة و الرأى لكم فى النهاية الكود : Sub creatingFormats() On Error Resume Next For Each cell In Range("data") Range("formats").Cells(cell.Value).Copy cell.PasteSpecial Paste:=xlPasteFormats Next cell On Error GoTo 0 Application.CutCopyMode = False End Sub الكود يقوم بعمل تنسيقات عادية فى نطاق محدد هو data طبقا لتنسيقات يمكنك تعييرها فى خلايا نطاق آخر هو formats يمكن تطويع هذا الكود فى حال الرغبة فى عمل تنسيقات عادية متعددة داخل نطاق . تحياتى لكم و الى اللقاء بإذن الله تعالى مع كل جديد ومفيد كن حذرا ... أبو ضحكة جنان قاعد لك فى الملف أخوكم مختار حسين محمود الصعيدى تنسيقات بلا حدود.rar تنسيقات بلا حدود.rar

أستاذنا " محمّد حسن المحمّد " بارك الله فيك .. و جزاك الله خيرا و زادك من علمه و فضله أنت وكل الأخوة المشاركين بهذا الموضوع تحياتى

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

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

أخى أبو شعبان أرفق الملف مضغوطا بصيغة rar أو zip ليتعامل معه الزملاء

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

حبيبى الغالى المهندس / ياسر بارك الله فيك .. و جزاك الله خيرًا و زادها بميزان حسناتك تقبل خالص تحياتى وتقديرى

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

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

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

السلام عليكم ورحمة الله وبركاته البغض منا قد يرغب فى ازالة التنسيق الشرطى عن خلية أو نطاق لسبب ما مع ازالة أو ابقاء آثاره من تنسيقات مثل لون الخلايا و لون و حجم الخط .... الخ و بإذن الله تعالى سأعرض عليكم ــ اخوتى ــ كودين يؤديان هذه المهمة الأول : يقوم بازالة التنسيق الشرطى مع ازالة آثاره من نطاق محدد : Sub RemovingCFandEffects() ' Removing Conditional Formats and the Effects Dim Rng As Range Set Rng = Sheets("Sheet1").Range("A1:C10") Application.ScreenUpdating = False Rng.FormatConditions.Delete Application.ScreenUpdating = True MsgBox ("The Conditional Formats in The Range " & Rng.Address & vbCrLf & " has been Removed and The Effects") End Sub الثانى : يقوم بازالة التنسيق الشرطى من نطاق محدد مع ابقاء آثاره من تنسيقات كما هى أو بعبارة أخرى تحويل التنسيقات الشرطية الى تنسيقات عادية : Sub RemovingCFbutNotEffects() ' Removing Conditional Formats but not the Effects Dim Rng As Range, C As Range Set Rng = Sheets("Sheet1").Range("A1:C10") Application.ScreenUpdating = False For Each C In Rng ' Rng.SpecialCells(xlCellTypeAllFormatConditions) With C .Interior.Color = .DisplayFormat.Interior.Color .Font.FontStyle = .DisplayFormat.Font.FontStyle .Font.Color = .DisplayFormat.Font.Color .FormatConditions.Delete End With Next Application.ScreenUpdating = True MsgBox ("The Conditional Formats in the Range " & Rng.Address & vbCrLf & "has been removed but Not the Effects ") End Sub أتمنى أن يكون موضوعا سهلا وخفيفا ونافعا لكم ... تقبل الله منا و منكم صالح الأعمال والسلام عليكم ورحمة الله وبركاته Removing Conditional Formats.rar

السّلام عليكم و رحمة الله و بركاته أخى عبدالعزيز ما شاء الله عليك شعلة نشاط بارك الله فيك .. و جزاك الله خيرًا و زادها بميزان حسناتك

تفضل ملفك الأصلى الصفوف والفصول 3.rar