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

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

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

السلام عليكم

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

لكن أعتقد أنه فى النهاية يريد الآتى :

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    ليتعامل معه الزملاء

السلام عليكم ورحمة الله

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

حبيبى الغالى المهندس / ياسر

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

تقبل خالص تحياتى وتقديرى

أشكرك أخى سعد عابد

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

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

21 ساعات مضت, م / ياسر فتحى البنا said:

أخى الحبيب الغالى / مختار

أحييك من كل قلبى

دائما مواضيعك مثيرة وجديدة ورائعة

زادك الله من العلم الكثير والكثير

تقبل حالص تحياتى وتقديرى

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

أخى و أستاذى الكبير ياسر خليل بوركت ... كلماتك وسام على صدرى

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

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

السلام عليكم ورحمة الله وبركاته

البغض منا قد يرغب فى ازالة التنسيق الشرطى عن خلية أو نطاق لسبب ما

مع ازالة أو ابقاء آثاره من تنسيقات مثل لون الخلايا و لون و حجم الخط  .... الخ

و بإذن الله تعالى سأعرض عليكم ــ  اخوتى ــ كودين  يؤديان هذه المهمة 

الأول : يقوم بازالة التنسيق الشرطى مع ازالة آثاره  من نطاق محدد  :

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