طارق محمود

ممكن إن شاء الله بس اكتب لي مثلا إسم أو أسماء الملفات والفولدر وسوف أضبطها علي الأساس

السلام عليكم أخي أبو مهند هناك حل بإستخدام السولفر وهي أداة ملحقة مع الإكسل أنظر المرفق وفيه نطلب من السولفر تقليل قيمة الخلية H21 الصفراء لأدني قيمة يستطيعها السولفر وذلك عن طريق تغيير قيم الخلايا B15:F17 وبشرط أن تكون قيم تلك الخلايا B15:F17 صحيحة الفكرة أن تقوم بتكوين معادلات تحسب لك الفارق بين المفروض والمقترح من السولفر (لأنه سيقوم بتغيير قيم الخلايا B15:F17) ومن الأفضل أن تحسب مربع الفارق وليس الفارق بينهما لأن الفارق إن كان سالبا او موجبا ، يكون مربع الفارق دائما موجبا وبتجميع هذا المربع للفارق في خلية يقوم السولفر بمحاولة تقليلها للحد الأدني (لن يقل عن صفر لأنها موجبة) أنظر المرفق Tareq_Solver.rar

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

السلام عليكم أخي الكريم بفرض ان إسم الفولدر المراد إنشاؤه Folder1 غير الكود إلي التالي Sub Button3_Click() xx = ActiveWorkbook.Path & "\Folder1" MkDir (xx) Set NewBook = Workbooks.Add With NewBook '.Title = "All Sales" '.Subject = "Sales" .SaveAs Filename:=xx & "\" & "m.xlsx", CreateBackup:=False End With Workbooks.Open Filename:=xx & "\" & "m.xlsx" Sheets.Add ActiveSheet.Name = "TDR" ActiveWorkbook.Close savechanges:=True End Sub

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

السلام عليكم عندك أخي بوعلام فالسطر التالي يضع إسم المادة الأولي في الصف t_deprt = sh.Cells(8 * Int(j / 8), 2) & " -- " & sh.Cells(j, 5) وهو سطر في منتصف الكود والمفروض ان يضع إسم المادة المجاورة للأستاذ تماما بنفس التنسيق في ورقة "حجز مواقيت الأقسام" لذلك فقط عدل هذا السطر ليكون t_deprt = sh.Cells(8 * Int(j / 8), 2) & " -- " & sh.Cells(j, day_col-1) ويكون الكود كله بعد التعديل Sub t_booking() Dim sh As Worksheet Sheets("مواقيت الأساتدة").Activate last_row = [B10000].End(xlUp).Row Set sh = Sheets("حجز مواقيت الأقسام") last_row2 = sh.[D10000].End(xlUp).Row For rr = 8 To last_row If Cells(rr, 2) = "" Then GoTo 10 t_name = Cells(rr, 2) For day_col = 6 To 14 Step 2 For j = 8 To last_row2 If sh.Cells(j, day_col) = t_name Then t_time2 = sh.Cells(j, 4) t_deprt = sh.Cells(8 * Int(j / 8), 2) & " -- " & sh.Cells(j, day_col-1) ' هذا هو التعديل new_col = day_col / 2 + 2 For i = 0 To 7 t_time = Cells(rr + i, 4) If t_time = t_time2 Then Cells(rr + i, new_col) = t_deprt Next i End If Next j Next day_col 10 Next rr End Sub

السلام عليكم أخي الحبيب / بوعلام أولا إسمح لي فقد حذفت النسخة الأخري من الموضوع ، حيث انك وضعتها بالخطأ كما يحدث لنا جميعا ثانيا تفضل هذا الكود Sub t_booking() Dim sh As Worksheet Sheets("مواقيت الأساتدة").Activate last_row = [B10000].End(xlUp).Row Set sh = Sheets("حجز مواقيت الأقسام") last_row2 = sh.[D10000].End(xlUp).Row For rr = 8 To last_row If Cells(rr, 2) = "" Then GoTo 10 t_name = Cells(rr, 2) For day_col = 6 To 14 Step 2 For j = 8 To last_row2 If sh.Cells(j, day_col) = t_name Then t_time2 = sh.Cells(j, 4) t_deprt = sh.Cells(8 * Int(j / 8), 2) & " -- " & sh.Cells(j, 5) new_col = day_col / 2 + 2 For i = 0 To 7 t_time = Cells(rr + i, 4) If t_time = t_time2 Then Cells(rr + i, new_col) = t_deprt Next i End If Next j Next day_col 10 Next rr End Sub وهذا المرفق ، إضغط الزر الأزرق "مواقيت الأساتدة" المواقيت.rar

السلام عليكم ورحمة الله و بركاته أختنا الفاضلة / fzsss إخواني الأحباء وأساتذتي / سعد عابد / kemas / خبور خير /عادل حنفي / ياسر الحافظ / محمود علي / يوسف عطا / أحمد فضيلة جزاكم الله جميعا كل خير علي السؤال أنتم وكل الأعضاء والقائمين علي الموقع وعلي رأسهم الحبيب الغالي / محمد طاهر الحمد لله ، أنا بخير بفضله وكرمه سبحانه وتعالي أنا فقط كنت بعيد عن النت لانشغالي بالأجازة ، فقد كنت في مصر الأسبوعين الماضيين اليوم رجعت من مصر ويشرفني التواصل معكم من جديد والسلام عليكم طارق محمود

السلام عليكم اليوم مع دالة من دوال الإكسل العظيمة وهي دالة INDEX ستجدون شرحا مبسطا لأخونا الأستاذ العلامة / يحي حسين علي هذا الرابط http://www.officena.net/ib/index.php?showtopic=37497 تمنياتي بالتوفيق

من المهم معرفة ان الكود حساس لحالة الأحرف مثلا لديك بالملف السابق خليتين بهما كلمة Bad فلو كتبت مثلا bad أو BAD فلن يحذف شيئا بالنسبة لقيمة الخلايا أيضا لابد أن يكون الرقم بالضبط فإذا كان الرقم بالخلية ناتج عن عملية معينة مثلا 9.01 وأنت إخترت إلغاء قيمة 9 فلن يلغيه وهكذا

السلام عليكم بعد إذن اخي العيدروس أخي مدي تفضل المرفق إن شاء الله به ماتطلب وهذا هو الكود Sub deletX() Dim x As String, y As Long d = WorksheetFunction.Find("a", "Tarek") x = InputBox("What is the word you want to delete Cells contain it?") If x <> "" Then GoTo 10 y = InputBox("What is the Value you want to delete Cells contain it?") For Each ce In Range("A1", Cells.SpecialCells(xlLastCell)) If ce.Value = y Then ce.ClearContents Next ce Exit Sub 10 For Each ce In Range("A1", Cells.SpecialCells(xlLastCell)) On Error Resume Next If Len(ce) < Len(x) Then GoTo 20 aa = WorksheetFunction.Find(x, ce) If aa > 0 Then ce.ClearContents 20 aa = 0 Next ce End Sub Delete_Fixed_Cells.rar

السلام عليكم أخي العزيز لاتتسرع بل يمكن طبعا تطبيق هذه الخطوات فى 2007، 2010 فقط هناك جزئية لم أوضحها جيدا إذا كنت تستخدم 2007 ستجد قائمة اسمها Developer إذا لم تجدها ، إذهب إلي Options ثم Customize Ribbon وفعل المربع الذي أمامها في المشاركة #9 ذكرت لك المهم من هذه القائمة Developer إختر Controls ثم أيكونة Insert Photo التي تشبه الأهرامات ثم أدرج صورة ، أي صورة أنظر الصورة المرفقة أخيرا قف علي هذه الصورة وفي مكان المعادلات بالأعلي أكتب = ثم إسم المجال الذي تريد تصويره بدلا من هذه الصورة أنظر الفيديوالمرفق Insert_Photo_Vid.rar

السلام عليكم تفضل الكود Sub T_goto() a = Selection.Value If ActiveSheet.Name <> Sheets(2).Name Then MsgBox ("This is not Sheet2"): Exit Sub x = Sheets(1).[A1000].End(xlUp).Row For Each ce In Sheets(1).Range("A2:A" & x) If ce.Value = a Then rr = ce.Row: Exit For Next ce If rr = 0 Then MsgBox ("No name matching " & a & " in Sheet1"): Exit Sub Sheets(1).Select Cells(rr, 1).Select End Sub والمرفق به الكود والزر تفضل الانتقال الى نفس الاسم.rar

مرفق الملف وبه الكود المعدل سالب المجموع4.rar

السلام عليكم نعم أختي لكني لاأستطيع إرفاق ملفات من هذا الجهاز الآن عموما هذا هو الكود ، حاولي نقله ووضع زر لـــــ سالب المجموع الأفقي وزر لــــ تفريغ سالب المجموع الأفقي تفضلي الكود بالحالات كلها Sub Saleeb() Dim x As Integer x = InputBox("Which Group you want?") For i = 5 To 1000 If Cells(i, 1).Value = x Then Cells(i + 3, 2).Value = -Cells(i + 2, 2): Exit Sub Next MsgBox ("There's NO Group Number " & x) End Sub Sub NoSaleeb() For i = 6 To 1000 If Cells(i, 1).Value > 0 Then Cells(i + 3, 2).ClearContents Next End Sub Sub HzSaleeb() Dim x As Integer x = InputBox("Which HZ Group you want?") y = [D1000].End(xlUp).Row ' Last Row For i = 20 To y If Cells(i, 4).Value = x Then Cells(i, 8).Value = -Cells(i, 7): Exit Sub Next MsgBox ("There's NO Group Number " & x) End Sub Sub NoHzSaleeb() y = [H1000].End(xlUp).Row ' Last Row If y < 20 Then y = 20 Range("H20:H" & y).ClearContents End Sub

السلام عليكم الاخت افاضلة تم تعديل الكود وتجربته علي المجموعات بالورقة الثانية تم إختيار خلايا السالب علي اساسين لايجب تغيير أي منهما (1) أن رقم المجموعة موجود بالعمود الأول (2) أن عدد صفوف المجموعة(خلايا) = 5 صفوف الصف الرابع به سالب المجموع أي أن الكود سيسأل عن رقم المجموعة المراد عمل سالب لها ثم سيبحث في خلايا العمود A عن هذا الرقم ومن ثم يغير محتوي الخلية التي علي يساره للأسفل 3خلايا إلي سالب قيمة الخلية التي تعلوها وإذا لم يجد رقم المجموعة في العمود A فلن يفعل شيئا ويخبر بأن الرقم غير موجود تفضلي المرفق سالب المجموع3.rar

السلام عليكم الاخت افاضلة أرجو ان يكون ماتريدين هو الذي بالورقة الثانية تم إختيار خلايا السالب علي اساس اللون أي أن الكود سيبحث في خلايا العمود B عن هذا اللون الرمادي ومن ثم يغير محتواها إلي سالب قيمة الخلية التي تعلوها ووضعت لكي كود آخر لحذف السالب من نفس الخلايا (إن إحتجتي) تفضلي المرفق سالب المجموع.rar

السلام عليكم ليس من المفروض ان تحدث مشاكل في هذه الحالة ولكن للأسف ليس لدي لأتتبع مصدر الخطأ لذلك حللتها لك بما رأيته أسرع من هذا الكم من المعادلات COUNTIF - ROWS - INDEX - SUMPRODUCT - IF في خلية واحدة ، أحسستها تستغيث في الخلية B6 من ذات الشييت (الايتام ) اكتب المعادلة التالية =VLOOKUP(SMALL('11'!B:B,$A6),'11'!$B$6:$AS$196,2,0) ثم انسخها للباقي

السلام عليكم أخي الكريم استبدلت المعادلات الطويلة بمعادلة أبسط وإن شاء الله لاتجد أخطاء بعد ذلك بالملف تفضل المرفق قاعدة بيانات2.rar

السلام عليكم أخي العزيز يوجد نفس الموضوع بالمنتدي وقد شاركت في الرد عليه سابقا الموضوع اسمه : ترتيب الشيكات للأخ الموسطي تجده علي الرابط http://www.officena.net/ib/index.php?showtopic=35500&st=0&p=187313&hl=+%D4%ED%DF%C7%CA%20+%E1%E1%DA%E3%E1%C7%C1&fromsearch=1&#entry187313

السلام عليكم أخي العزيز ، الشرح الفيديو لن يفيد كثيرا ثم إن الأوفيس عندي 2010 سأحاول الشرح كتابة وإن شاء الله ستجد إجابة لمعظم مايقلقك أولا لتسمية نطاق أو مدي أو مجال لديك نوعين إما ثابت أو متغير (ديناميكي) ثانيا وللتعرف علي مالديك من أسماء بالملف قف عند أي مساحة فارغة بالملف ثم إضغط F3 في ملفنا هذا ستجد إسمين ( الاسم - photo ) وإذا إخترت Paste List سيكتب لك أسماء المجالات (النطاقات) التي تم تسميتها في هذا الملف ويكتب أيضا مراجعها يعني في ملفنا هذا ستجد أن (1) المجال ( الاسم ) يرجع للمدي الثابت $B$8:$B$125 في ورقة 'بيانات اساسيه' ، لايتغير (2) المجال (photo) فتلاحظ أنه يرجع للمدي المتغير المعتمد علي الخلية الثابتة C2 في ورقة (صور) ببساطة أكثر أنك مثلا إن سميت الخلية A1 بإسم AGE للتعبير عن عمر شخص ما وكانت هذه الخلية A1 بها رقم 30 ففي أي موضع من ذات الملف تكتب =AGE تجد 30 وإن غيرت محتوي الخلية A1 سيتغير ناتج المعادلة =AGE هذا بالنسبة للمدي الثابت لكن إن جعلت الإسم AGE لايعود للخلية A1 مباشرة بل يعود إلي جارتها التي أسفلها يعني A2 فأنت حين تسمي المجال لاتذكر A2 بل تنسبه إلي A1 بترحيل خلية للأسفل ففي تلك الحالة ، لو في أي موضع من ذات الملف تكتب =AGE تجده يأتيك بمحتوي الخلية A2 وإن غيرت محتوي الخلية A1 لن يتغير ناتج المعادلة =AGE بل سيتغير فقط إن غيرت محتوي الخلية A2 هذا مايسمي بالمدي المتغير (الديناميكي) وعادة مانستخدم دالة OFFSET للرجوع إلي خلية بدلالة أخري ثالثا والآن نرجع لكيفية تسمية النطاقات (1) الثابت :ظلل المجال الذي تريد تسميته إضغط Ctrl-F3 وأكتب الإسم الذي تريده ثم إختر Add ، تأكد أن نافذة Refers to تحتوي العنوان الذي ظللته وإلا إضغطها وظلله من جديد قبل إختيار Add (2) المتغير :إضغط Ctrl-F3 وأكتب الإسم الذي تريده وفي نافذة Refers to أكتب المعادلة التي تحتوي العنوان المتغير الذي تريده ثم إختر Add رابعا ونرجع للمعادلة التي بالملف والخاصة بالمجال المتغير (photo) =OFFSET(صور!$C$2,Register!$M$4,0,1,1) تعني أنها تبعد عن الخلية الثابتة C2 في ورقة (صور) بمقدار عدد صفوف X وأعمدة صفر علي أن X هذه تساوي قيمة الخلية الثابتة M4 في ورقة (Register) ومن ناحية أخري فهذه الخلية الثابتة M4 في ورقة (Register) بها معادلة تأتي بترتيب الموظف بين زملاؤه حسب الجدول الموضوع بالورقة (بيانات اساسيه) المعادلة هي =MATCH(D9,'بيانات اساسيه'!$B$8:$B$13,0) إذا لم يزل لديك أسئلة فلاتتردد

السلام عليكم أخي الحبيب /عموور الحمد لله أن وفقنا للحل الذي تريد ولاتتردد في أي سؤال أخي الحبيب / ياسرالحافظ أخي الحبيب / سعد عابد جزاكما الله كل الخير علي مروركما الكريم وكلماتكما الطيبة اللهم وفقنا جميعا لما فيه الخير والصلاح

السلام عليكم أهلا ومرحبا بك أخي الكريم بين إخوانك إن شاء الله تجد مايسرك وتستفيد وتفيد معنا بإذن الله أخي العزيز مرفق الملف وبه الحل بطريقتين مع الشرح أنتظر ردك إن كان هذا ماتريد أم مازلت تريد الأكواد 22222.rar

السلام عليكم بعد إذن اساتذتنا وإخواننا الأعزاء هشام شلبي / عادل حنفي / عبدالله المجرب أخي الكريم ممكن بدون اكواد عن طريق المدي الديناميكي إقتبست لك من أعمال أستاذنا الحبيب / أبوتامر ، رده الله سالما بإذنه سبحانه وتعالي مرفق ملفك وللشرح تم عمل التعديلات التالية تغير اسم الورقة صحيفة احوال إلي Register للتسهيل إضافة ورقة اسمها صور يوضع بها صور الموظفين كما بالمرفق ، كل صورة في خلية تم تسمية مدي متغير (ديناميكي) مثلا photo بحيث يحتوي علي مافي هذه الخلية الواحدة المقابلة لإسم الموظف تم إضافة صورة أخري (أي صورة) في الخلية المدمجة مكان الصورة والتي تبدأ ب H3 من الورقة Register أنظر المرفق وأنا معك في أي سؤال عرض الصور بلاأكواد.rar

السلام عليكم أخي العزيز إستبدل الكود التالي بدلا عن الأول Private Sub Worksheet_Change(ByVal Target As Range) If [C5] <> Sheets(2).[H7] And [C5] <> "" Then Sheets(2).[H7] = [C5] If [D5] <> Sheets(2).[I7] And [D5] <> "" Then Sheets(2).[I7] = [D5] If [E9] <> Sheets(2).[J13] And [E9] <> "" Then Sheets(2).[J13] = [E9] If [F9] <> Sheets(2).[K13] And [F9] <> "" Then Sheets(2).[K13] = [F9] End Sub وإذا كنت لاتريد الترحيل إن كانت نتيجة المعادلة صفر وليس "" فاستخدم هذا الكود Private Sub Worksheet_Change(ByVal Target As Range) If [C5] <> Sheets(2).[H7] And [C5] <> 0 Then Sheets(2).[H7] = [C5] If [D5] <> Sheets(2).[I7] And [D5] <> 0 Then Sheets(2).[I7] = [D5] If [E9] <> Sheets(2).[J13] And [E9] <> 0 Then Sheets(2).[J13] = [E9] If [F9] <> Sheets(2).[K13] And [F9] <> 0 Then Sheets(2).[K13] = [F9] End Sub