احمد عبد الناصر

السلام عليكم استاذ ريان في الملف الجديد لا اجد بيانات التبعية في اي شيت في الملف الاول كانت مثلا (cit1) تحت عمود التبعية , اما في هذا الملف غير موجودة ارجو التوضيح . تحياتي

السلام عليكم بالنسبة للمعادلة فهي تحسب الرقم او الحرف او الرمز او المسافة . بالنسبة لموضوع الرقم 11 ففكرة الماعدلة قائمة علي ان الخلاية في كل عمود متساوية في عدد الخانات فان كانت 11 تكتب في المعادلة 11 و ان كانت 12 تكتب في المعادلة 12 بدلا من 11 و ان كانت 5 مثلا تكتب 5 بدلا من 11 و هكذا فالمهم ان تكون عدد الخانات في كل عمود واحدة (كل عامود عي حدا) و ليس كل الاعمدة . ارجو ان تكون قد وضحت الفكرة اما بالنسبة لل weld ID هل تقصد نفس النتيجة الذي يخرجها ال pivote و ان كان فلما تستبدله بمعادلات ؟! تحياتي

السلام عليكم معذرة لا اعلم حل لهذه المشكلة . من الممكن ان يكون هناك حل مؤقت لتسريع الملف قليلا و هذا يحتاج الاطلاع علي الملف . او اعادة تصميم الملف من البداية بطريقة تجعله خفيف و سريع و دقيق (هذا الحل الاصعب). اعتقد انه من الافضل ان ترفق الملف في موضوع جديد و ستجد من الاخوة الاعضاء و الاساتذة الخبراء حل او حلول لهذه المشكلة . و الله اعلم تحياتي

السلام عليكم استاذ عباد تحياتي لك استاذ deep تحياتي لك جرب هذا التعديل If Ch.TextToDisplay <> Tn Then Else Ch_he = 1: Exit Function

السلام عليكم جرب هذا تحياتي +تقريب الكسر الى رقم صحيح.rar

السلام عليكم كمحاولة ممكن ان تستبدله بهذا الكود (لكن مشكله عدم التراجع ما زالت قائمة) Private Sub Worksheet_Activate() On Error Resume Next If Range("k1").Value > 0 Then Columns("E").Hidden = False Else Columns("E").Hidden = True End If End Sub تحياتي

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

السلام عليكم جرب المرفق الانظار يظهر ان كان خلال 10 ايام تحياتي كشف شقق آجار+.rar

السلام عليكم تحياتي للجميع اسعد الله صباحكم وهذا بالنسبة للجمع +تغيير اسم اليوم تلقائي.rar

استاذ احمد عبد الفتاح حياك الله زادك الله علما و نفع بك إِنَّ اللَّهَ مَعَ الصَّابِرِينَ تحياتي

السلام عليكم جرب هذا Sub OFFICNA1() Dim LR As Long, LR2 As Long, ws As Worksheet, ws2 As Worksheet Set ws = Sheets("1") Set ws2 = Sheets("1") LR = ws.Range("a" & Rows.Count).End(xlUp).Row LR2 = ws2.Range("co" & Rows.Count).End(xlUp).Row If ws.Range("a9").Value = "" Then MsgBox ("áÇ ÊæÌÏ ÈíÇäÇÊ áÊÑÍíáåÇ") Exit Sub End If Dim c c = MsgBox("ÃäÊ ÈÕÏÏ ÊÑÍíá ÌãíÚ ÇáÓÌáÇÊ Çáì ÇáÃÑÔíÝ Ýåá ÊæÇÝÞ¿", 36, "ÊÍÐíÑ") If c = 6 Then ws.Range("a9:l" & LR).Copy ws2.Range("co" & LR2 + 1) ws.Range("a9:l" & LR).ClearContents ws.Select MsgBox "Êã ÇáÊÑÍíá ÈäÌÇÍ!", vbInformation + vbMsgBoxRight, "Êã ÇáÊÑÍíá" End If End Sub الفكرة في اضافة Exit Sub تحياتي

السلام عليكم استاذ محمود تحياتي لك فكرة جميلة ومعادلة متقنة . استاذ محمد سعد تحياتي لك بالنسبة للملف جرب المرفق الحل يعتمد علي -حساب عدد الخانات في الخلية مثلا SPPP-RT-016 غالبا هي موحدة 11 لكن في عمود Magnetic Particle Test فهي 12 SPPP-MPI-017 فيجب ان تأخذ هذا في الاعتبار . -هذا الجزء من المعادلة (LEN(data!$S$5:$S$68)/11,0) سوف تغير رقم 11 الي 12 او تتركه 11 علي حسب عدد الخانات في خلايا العمود المراد حسابه والمدي data!$S$5:$S$68 تغير ال S بالعمود الذي تريده تركت لك الملف لتكمل باقي المعادلات و ان صادفتك مشكله اكمله لك . تحياتي Draft+.rar

السلام عليكم استاذ محمد جرب هذا المرفق فهو باستخدام معادلات , ربما كان التعديل فيها اسهل .(منقولة من excelisfun) اما بالنسبة للحل الاول فهو باستخدام دالة معرفة اي كود (اضغط علي alt+F11 ثم انظر بداخل module 1 ) تحياتي Book1+split+-.rar

جرب هذا يبحث في الخلاية التي تحتوي علي H . Book1+split.rar

السلام عليكم جرب هذه باستخدام دالة معرفة ,لكن تعتمد علي وجود & بين كل فاتورة . تحياتي Book1+split.rar

وجرب هذا الاستعلام لتستغني عن التقسيمة و توجد الاسم الاخير ايا كان موقعه SELECT TabNames.ID, TabNames.FullName,right(fullname,len(fullname)-instrrev(fullname," ")) from tabnames تحياتي

السلام عليكم جرب هذا IIf([FourthName] <> '',[FourthName],[ThirdName]) AS FamilyName تحياتي

السلام عليكم الاساتذة و الاخوة الكرام شكرا علي هذه الكلمات الطيبة تحياتي

حسنا

السلام عليكم مجهود موفق باذن الله ,جزاك الله خيرا و نفع بك . تحياتي

السلام عليكم تحياتي للجميع , اسعد الله اوقاتكم هذا الكود غير مسجل في مكرو ولكن في حدث الصفحة يعمل بالضغط علي الخلايا الداكنة

السلام عليكم جرب هذا تحياتي Sub dahmour() Application.ScreenUpdating = False For Each c In Range("ae9:ah" & Range("a" & Rows.Count).End(xlUp).Row) c.Value = color(Range("f" & c.Row & ":ad" & c.Row), c.Interior.color) Next Application.ScreenUpdating = True End Sub Function color(r, i) For Each c In r If c.Interior.color = i Then color = color + 1 Next End Function كشف+حضور+الادارة+.rar

السلام عليكم تحياتي للجميع , اسعد الله اوقاتكم جرب هذا التعديل ارتباط تشعبي متغير في نموذج+-.rar

السلام عليكم اسعد الله صباحك استاذ خالد و تحياتي بالطبع لاستاذنا الفاضل طارق جرب هذا Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) On Error GoTo D_Date If Target.Column = 2 And Target.Row >= 20 And Target.Row <= 100 Then If Cells(Target.Row, 93) = "حجب" Then Cells(Target.Row, 93).ClearContents Else Cells(Target.Row, 93) = "حجب" Cancel = True End If D_Date: Application.EnableEvents = True Application.ScreenUpdating = False End Sub

شكرا استاذ ضاحي الغريب