اذهب الي المحتوي
بحث مخصص من جوجل فى أوفيسنا
Custom Search

ابراهيم الحداد

الخبراء
  • Content Count

    823
  • تاريخ الانضمام

  • تاريخ اخر زياره

  • Days Won

    3

ابراهيم الحداد last won the day on أبريل 21 2018

ابراهيم الحداد had the most liked content!

السمعه بالموقع

585 Excellent

عن العضو ابراهيم الحداد

  • الإسم الفعلي
    الإســم

البيانات الشخصية

  • Gender (Ar)
    ذكر
  • Job Title
    teacher
  • بلد الإقامة
    Aswan
  • الإهتمامات
    Excel

اخر الزوار

3,175 زياره للملف الشخصي
  1. السلام عليكم ورحمة الله الف مبروك خبيرنا الجديد استاذ / حسين تهنئة واجبة اليك و لادارة المنتدى على حسن الاختيار
  2. السلام عليكم ورحمة الله يجب وضع اسماء الصور فى العمود "B" بجوار الارقام اليك الملف المعلومات المدنية.rar
  3. السلام عليكم ورحمة الله جرب هذا الجدول T_Table.xlsm
  4. السلام عليكم ورحمة الله و يمكنك ايضا ان تجرب هذا الملف ربما يفيدك توزيع رغبات2.xlsm
  5. السلام عليكم ورحمة الله ربما يفيدك هذا الملف جدول صباحى.xlsm
  6. السلام عليكم ورحمة الله استخدم هذا الكود وخصص له زر Sub TransData() Dim ws As Worksheet, Sh As Worksheet Dim LR As Long, ShName As String Set Sh = Sheets("Form") ShName = Sh.Range("B9") For Each ws In ThisWorkbook.Worksheets LR = ws.Range("A" & Rows.Count).End(xlUp).Row If ws.Name = ShName Then ws.Range("A" & LR + 1 & ":G" & LR + 1).Value = _ Application.Transpose(Sh.Range("B2:B8").Value) End If Next Application.CutCopyMode = False End Sub ترحيل البيانات من نموذج تسجيل الى جميع الصفحات بإسم الصفحة.xlsm
  7. السلام عليكم ورحمة الله اخى الكريم فتحى ابو الفضل الحقيقة ان الملف كبير جدا و حاولت معرفة سبب الخطأ و هو خطأ واحد ترتب عيه عدة اخطاء فى الشيتات المرتبطة بشيت الخطأ الاول حيث ان الصفين السابع و الثامن الوحيدين المرتبطين بخلية فى الاعمدة الاخيرة ومن المرجح ان هذا هو سبب الخطأ حيث لا توجد اخطاء فى باقى الصفوف مع العلم اننى عندما قمت بتجريب الكود مرة اخرى و حدث الخطأ فقمت بإغلاق الملف بدون حفظ و اعدت الكرة مرة اخرى تمت المهمة بنجاح بغرابة شديدة لهذا اعتذر عن تقديم تفسير مناسب لتلك الظاهرة لى طلب بسيط ان نمسح من الكود الاوامر الخاصة بالترقيم و استخدام هذه المعادلة بدلا منها كما هى : =IF(B7="";"";SUBTOTAL(3;$B$7:B7)) ليصبح الكود بعد التعديل كالتالى : Sub DelRows() Dim Sh As Worksheet, Msg As String Dim Nam As String Dim i As Long, x As Long, LR As Long Application.ScreenUpdating = False t = Timer Nam = ActiveCell.Value Msg = MsgBox("من كافة الشيتات" & " " & Nam & " " & "هل تريد فعلا ازالة السيد / ", vbYesNo) For Each Sh In Worksheets(Array("ادخال بيانات 155", "بدلات 155", "نقابات 155", "استقطاعات 155", "جزاءات 155", "بيانات معلمين-1", "بيانات معلمين", "مرتب 155", "مرتب 155")) Sh.Unprotect ("fathy_100") LR = Sh.Range("B" & Rows.Count).End(xlUp).Row For i = LR To 7 Step -1 If IsEmpty(Nam) Then Exit Sub If Sh.Cells(i, 2) = Nam Then If Msg = vbYes Then On Error Resume Next Sh.Rows(i).Delete End If End If Next Sh.Protect Next MsgBox Round(Timer - t, 2) Application.ScreenUpdating = True End Sub
  8. السلام عليكم ورحمة الله اخى تم عمل تعديل بسيط للكود ليعمل بصورة اسرع و اكفأ اهم اسباب بطء الكود بعض التنسيقات غير الضرورية الرجا مراجعتها و ازالة ما لا يلزم منها استبدل الكود السابق بهذا الكود : Sub DelRows() Dim Sh As Worksheet, Msg As String Dim Nam As String Dim i As Long, x As Long, LR As Long Application.ScreenUpdating = False t = Timer Nam = ActiveCell.Value Msg = MsgBox("من كافة الشيتات" & " " & Nam & " " & "هل تريد فعلا ازالة السيد / ", vbYesNo) For Each Sh In Worksheets(Array("ادخال بيانات 155", "بدلات 155", "نقابات 155", "استقطاعات 155", "جزاءات 155", "بيانات معلمين-1", "بيانات معلمين", "مرتب 155", "مرتب 155")) Sh.Unprotect ("fathy_100") LR = Sh.Range("B" & Rows.Count).End(xlUp).Row For i = LR To 7 Step -1 If IsEmpty(Nam) Then Exit Sub If Sh.Cells(i, 2) = Nam Then If Msg = vbYes Then On Error Resume Next Sh.Rows(i).Delete End If End If Next j = 7 Do While j <= LR If Sh.Cells(j, 2) <> "" Then Sh.Cells(j, 1) = j - 6 End If j = j + 1 Loop Sh.Protect Next MsgBox Round(Timer - t, 2) Application.ScreenUpdating = True End Sub
  9. السلام عليكم ورحمة الله اخى الكريم فتحى كل عام و انتم بخير اثناء العمل على محاولة تصحيح الخطأ نبين ان هناك صفحات محمية بكلمة سر فالرجاء اما ارسال كلمة السر او ارسال نسخة من الملف عير محمية و حبذا لو كان يحتوى على الشيتات المراد العمل عليها فقط
  10. السلام عليكم ورحمة الله جرب هذا الملف ربما يفيدك CombTest.xlsm
  11. الف الف مبروك تستحقها عن جدارة و استحقاق نراك قريبا فى اعلى المراتب ان شاء الله
  12. =COUNTIF($C$5:C5,C5)+VLOOKUP(C5,{"اعدادي",19100;"ثانوي",19200},2,0)-1 السلام عليكم ورحمة الله استخدم المعادلة التالية فى العمود "D" =IF(C5="اعدادي";COUNTIF(C5:$C$5;C5)+19100;IF(C5="ثانوي";COUNTIF(C5:$C$5;C5)+19200;"")) استاذ ابراهيم تكفي هذا المعادلة =COUNTIF($C$5:C5,C5)+VLOOKUP(C5,{"اعدادي",19100;"ثانوي",19200},2,0)-1 مع مراعاة ( الفاصلة والفاصلة المنقوطة _حسب اعادادات الجهاز عنكم)
  13. السلام عليكم ورحمة الله تفضل اخى الكريم استخراج الصنف.xlsm
  14. السلام عليكم ورحمة الله استخدم المعادلة التالية =IF(MID(REPLACE(C2;1;LEN("فاتورة بيع");"");1;3)=" AC";" ابواب ";IF(MID(REPLACE(C2;1;LEN("فاتورة بيع");"");1;3)=" CH";"كابينات";IF(MID(REPLACE(C2;1;LEN("فاتورة بيع");"");1;3)=" YK";"سطح ";"")))
  15. السلام عليكم ورحمة الله تم دمج الكودين السابقين حتى يعملا ككود واحد تم تحديد عمل الكود على 14 ورقة فقط حيث يوجد تماثل بينهم رجاء جعل الاسماء فى عمود "B" فقط و المسلسل فى عمود "A" سيقوم الكود بالحذف و الترقيم فى آن واحد حتى يتم المحافطة عاى التنسيقات الكود سيكون بطئ نوعا ما عسى الله ان اكون قد وفقت اليك الكود : Sub DelRows() Dim Sh As Worksheet, Msg As String Dim Nam As String Dim i As Long, x As Long, LR As Long Nam = ActiveCell.Value Application.ScreenUpdating = False Msg = MsgBox("من كافة الشيتات" & " " & Nam & " " & "هل تريد فعلا ازالة السيد / ", vbYesNo) For Each Sh In Worksheets(Array("ادخال بيانات 155", "بدلات 155", "نقابات 155", "استقطاعات 155", _ "جزاءات 155", "بيانات معلمين", "مرتب 155-1", "مرتب 155", "ادخال بيانات 81", "نقابات 81", _ "استقطاعات 81", "جزاءات 81", "مرتب 81", "مرتب 81-1")) For i = 1000 To 7 Step -1 If Nam = "" Then Exit Sub If Sh.Cells(i, 2) = Nam Then If Msg = vbYes Then On Error Resume Next Sh.Rows(i).Delete Else: Exit Sub End If End If Next With Sh LR = .Range("B" & Rows.Count).End(xlUp).Row For p = 7 To LR .Range("A" & p) = p - 6 Next End With Next Application.ScreenUpdating = True End Sub
×
×
  • اضف...