نجوم المشاركات

يوجد رموز غير مطبوعة نتيجة اختلاف نظام التشغيل في الأجهزة المستخدمة في تصدير هذه البيانات واستيرادها لحذف هذه الرموز نستعمل هذه المعادلة =SUBSTITUTE(SUBSTITUTE(A1,CHAR(13),""),CHAR(10),"") بالتوفيق

Private Sub Worksheet_Change(ByVal Target As Range) Dim x, n As Long, r As Long, c As Long, m As Long Dim sh As Worksheet: Set sh = Sheets("رصيد") Application.EnableEvents = False If Target.Address = "$L$8" Then Range("J11:L20").ClearContents c = 10: r = 11 For n = 2 To sh.Cells(Rows.Count, 1).End(3).Row If sh.Range("b" & n) = Target Then Cells(r, c) = sh.Range("c" & n) r = IIf(c = 18, r + 1, r): c = IIf(c = 18, 10, c + 2) End If Next n ElseIf Target.Count = 1 And Target.Row >= 11 And Target.Row <= 22 And (Target.Column = 11 Or Target.Column = 13 Or Target.Column = 15 Or Target.Column = 17 Or Target.Column = 19) And IsNumeric(Target.Value) Then m = Cells(Rows.Count, 2).End(xlUp).Row + 1 x = Application.Match(Target.Offset(, -1).Value, Columns(2), 0) If Not IsError(x) Then Cells(x, 6).Value = Cells(x, 6).Value + Val(Target.Value) Else Cells(m, 2).Value = Target.Offset(, -1).Value Cells(m, 6).Value = Target.Value End If End If Application.EnableEvents = True End Sub

ما شاء الله، أسأل الله أن يبارك لك وينفع بك أمة محمد صلى الله عليه وسلم.

"عثرت على الشيت في منتداكم الروعة بحاول اتعلم من الكود واجهتنى مشكلة لم استطع فهم هذا السطر من الكود .FormulaR1C1 = "=IF(COUNT(RC10:RC[-1])=0,IF(IF(AND(IF(R2C="""",TRUE,RC3=R2C),IF(R3C="""",TRUE,RC4=R3C),IF(R4C="""",TRUE,RC5=R4C),IF(R5C="""",TRUE,RC6=R5C),IF(R6C="""",TRUE,RC7=R6C),IF(R7C="""",TRUE,RC8=R7C)),COUNT(R10C:R[-1]C)+1,"""")>R9C,"""",IF(AND(IF(R2C="""",TRUE,RC3=R2C),IF(R3C="""",TRUE,RC4=R3C),IF(R4C="""",TRUE,RC5=R4C),IF(R5C="""",TRUE,RC6=R5C),IF(R6C="""",TRUE,RC7=R6C),IF(R7C="""",TRUE,RC8=R7C)),COUNT(R10C:R[-1]C)+1,"""")),"""")" نهائي ثانية.xls

ممتاز فعلا افضل حل و بإحترافية تامة

السلام عليكم ورحمة الله وبركاته .. تحية طيبة، وبعد هذا ملف لإجازات الموظفين، الكود طويل جدًا، لو توجد طريقة لاختصاره حتى يعمل أكون لكم شاكرًا. ملف الإجازات - Copy.xlsm

جميعا بإذن الله

هذه محاولة على حسب الشرح في موضوعك الاصلي على الرغم من شح المعلومات قم بنسخ رؤوس العناوين اولا قبل تنفيد الكود Sub merge_sheets() Dim MUL As Variant Dim Ws As Worksheet MUL = Array("1", "2","3","4","مني","هناء" ) For Each Ws In Worksheets(MUL) Ws.UsedRange.Offset(1).copy Sheets("مجمع شيتات").Range("A" & Rows.Count).End(xlUp).Offset(1) Application.DisplayAlerts = False Application.DisplayAlerts = True Next Ws End Sub

بسم الله ما شاء الله .. دائما مميز في مساعدتك، ميزك الله بطاعته ورزقك أعلى الجنان.

لا يمكن حسابها بمعادلة في مكانها سينتج خطأ المرجع الدائري يمكنك استعمال هذه المعادلة في العمود BK مثلا =BF9-FLOOR(BF9,0.05) مع نسخ المعادلة لأسفل وقبل الطباعة يتم نسخ بيانات هذا العمود ( ctrl+c ) ولصقها في المكان المطلوب كقيم (كلك يمين ثم نختار الزر المكتوب عليه 123 ) بالتوفيق

هل تقصد نسخ البيانات من الشيتات المحددة إلى شيت مجمع شيتات؟ وإذا كان هذا هو المقصود فيمكنك استعمال هذا الكود Sub getdata2() Sheet1.Range("a3:o" & Sheet1.Cells(Rows.Count, 2).End(3).Row + 2).ClearContents mysh = Array("1", "2", "3", "4", "هناء", "مني") For Each n In mysh lr = Sheets(n).Cells(Rows.Count, 2).End(3).Row If lr > 2 Then lr2 = Sheet1.Cells(Rows.Count, 2).End(3).Row + 1 lr2 = IIf(lr2 < 3, 3, lr2) Sheet1.Range("b" & lr2 & ":o" & lr2 + lr - 3).Value = Sheets(n).Range("b3:o" & lr).Value End If: Next n Sheet1.Range("A3").Value = 1 Sheet1.Range("A3").AutoFill Destination:=Range("A3:A" & lr2 + lr - 3), Type:=xlFillSeries Sheet1.Range("A3").Select MsgBox "Done by mr-mas.com" End Sub الكود يقوم بنسخ بيانات الشيتات الموجودة في المصفوفة إلى شيت مجمع شيتات ويقوم بوضع مسلسل للكل مع ضرورة تنسيق الأعمدة حسب نوع البيانات التي ستكون فيها مثل التواريخ والأرقام الكبيرة والنصوص بالتوفيق

يمكنك استعمال هذا الكود Sub MoveData22() lr = Sheets("بيانات الموظفين").Cells(Rows.Count, 2).End(3).Row For n = 3 To lr - 1 Sheets("الإحصائية").Cells(n, Sheets("جدول الإجازات").Range("C5") + 4) = Sheets("جدول الإجازات").Range("AN" & n + 6) Next n Range("E9:AI" & lr + 5).ClearContents End Sub مع ملاحظة lr هو رقم آخر صف مكتوب فيه في شيت بيانات الموظفين ورقم العمود في شيت الاحصائية هو نفس رقم الشهر + 4 بالتوفيق

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

عليكم السلام يمكنك استعمال هذه المعادلة في الخلية D8 =IF(OR($B8="",$C8=""),"",IF(D7="",C7,D7)) مع نسخ المعادلة لأسفل ويمكن استعمال هذه في E8 =IF(OR($B8="",$C8=""),"",IF(E7="",C6,E7)) بالتوفيق

واياك أخي ابا الحسن ...... بالتوفيق ...

هذا الكود لوضع معادلات في الأعمدة K:N يمكنك وضع علامة التعليق قبل السطر التالي ليصبح هكذا ' .Value = .Value ثم قم بتشغيل الاجراء بالضغط على f5 ستحصل على المعادلة العادية في الخلايا من k11 إلى n11 وما بعدها بالتوفيق

طبعا هذا الكلام في حالة مخزن واحد .... لاتستطيع اخفائها في حالة اكثر من مخزن افتح الاستعلام qry_Items_Dates_2 في حالة التصميم ثم طبق الصورة ,,,,,,

https://onedrive.live.com/view.aspx?cid=832c5c741b70edcf&page=view&resid=832C5C741B70EDCF!165&parId=832C5C741B70EDCF!101&app=Excel الملف الذي نعريد التعديل علية علي موقع ون درايف عموما تم ارسال الرابط اعلاه

مجهود واضح واعمالك متقنة وان شاء الله من نجاح الى نجاح

لا يوجد مشكلة في نسخة الاكسل تنسيق التاريخ يتم تنظيمه من خلال: * تنسيق الخلايا في اكسل إلى date وتختار التنسيق المناسب * تنسيق التاريخ في المنطقة المختارة في لوحة التحكم control panel في الويندوز بالتوفيق

استاذى الفاضل انت رائع تسلم يمينك واناملك العبقرية كل الشكر والتقدير لحضرتك

آمين ولك مثل ما دعوت

Thank you very much for your kind attitude

الف مبروك على الترقية الى درجة خبير

أحسن الله إليكم ورفع منزلتكم في الدنيا والآخرة.

أستاذنا lionheart سلمت يداك

Sub Test() Const colResult As Integer = 4 Dim a, x, ws As Worksheet, dic As Object, m As Long, i As Long Application.ScreenUpdating = False Set ws = ThisWorkbook.Worksheets(1) With ws Set dic = CreateObject("Scripting.Dictionary") m = .Cells(Rows.Count, 1).End(xlUp).Row With .Columns(colResult) .ClearContents .Cells(1).Value = "Results" End With a = WorksheetFunction.Transpose(.Range("A1:B" & m).Value) For i = LBound(a, 2) To UBound(a, 2) If Not dic.Exists(a(1, i)) Then dic.Add a(1, i), a(2, i) Else dic.Item(a(1, i)) = dic.Item(a(1, i)) & ";" & a(2, i) End If Next i .Range("J1").Resize(UBound(dic.Keys) + 1) = Application.Transpose(dic.Keys) .Range("K1").Resize(UBound(dic.Items) + 1) = Application.Transpose(dic.Items) Set dic = Nothing With .Range("E2:E" & m) .Formula = "=COUNTIF($A$1:A2,A2)" End With For i = 2 To m x = Application.Match(.Cells(i, 1), .Columns(10), 0) If .Cells(i, 5) = 1 And Not IsError(x) Then If InStr(.Cells(x, 11), ";") Then .Cells(i, 4).Value = Mid(.Cells(x, 11).Value, InStr(.Cells(x, 11), ";") + 1) End If End If Next i .Columns(5).ClearContents .Columns("J:K").ClearContents End With Application.ScreenUpdating = True End Sub

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

الشكر لله وفقنا الله جميعا لكل خير

ماشاء الله , جهد مشكور .

ليس هذا ما اريده انا محتاج تسلسل يظهر لكل شهر ( يظهر في رقم الاوردر 1 . 2 . 3 . 4 . 5 . 100 ... الخ ) لما ادوس على الزرار يظهر اخر تسلسل للشهر +1 في خانة رقم الاوردر ولما احط تاريخ للشهر اللي الجاي يبتدي التسلسل من اول 1 . 2 . 3 . 4 . 5 .... ألخ

إذا استخدمت البحث كنت ستجد الكثير منها هذه المواضيع https://www.officena.net/ib/search/?&q=حماية الشيتات&type=forums_topic&quick=1&nodes=135&search_and_or=and&sortby=relevancy بالتوفيق

جميعا بفضل ربي يبدو أن حضرتك لم تلاحظ هذا السطر For r = 3 To Sheet1.Cells(Rows.Count, 1).End(3).Row الكود يقرأمن الصف 3 إلى آخر صف مكتوب فيه في العمود A في شيت بيانات الموظفين sheet1 يعني سيتم التنفيذ على أي عدد صفوف مكتوب في شيت بيانات الموظفين بالتوفيق

عليكم السلام في خانة : تحديث الى ضع الصيغة التالية : IIf([t2.total]=0;[t1.ram];[t2.total]) استعلام تحديث2.rar

ممتاز أستاذنا اشتغل الكود بنجاح؛ نفع الله بك. ...سؤال أخير لو تكرمت لو مثلا زدت عدد الموظفين إلى أكثر من العدد المكتوب إلى 100 أو مثلا نقصتهم إلى 5...من أين أستطيع التحكم في هذا الأمر في الكود؟

الأمر بسيط جدا يمكنك استعمال هذا الكود Sub export2pdf() For r = 3 To Sheet1.Cells(Rows.Count, 1).End(3).Row Sheet2.Range("b4") = Sheet1.Range("a" & r) Sheet2.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & Sheet2.Range("b4") & ".pdf" Next r MsgBox "Done by mr-mas.com" End Sub بالتوفيق

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

جميعا بإذن الله

Thank you very much for this trust. I am not expert, I am just a learner

Sub Test() Dim a, dic As Object, i As Long Set dic = CreateObject("Scripting.Dictionary") a = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value For i = LBound(a) To UBound(a) If dic.Exists(a(i, 1)) Then a(i, 1) = Empty Else dic.Add a(i, 1), 1 Next i Range("A1").Resize(UBound(a, 1), UBound(a, 2)).Value = a End Sub

وعليكم السلام ورحمة الله وبركاته أخي محمود شكرا لك على كلماتك الرقيقة كنت دائما أحاول المحافظة على شعار لبرامجي ألا وهو "ما خف وزنه وغلا ثمنه" ربنا يوفقني في إكمال هذه السلسلة بما هو نافع للجميع

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

أكرمك الله أخي القومي نفعنا الله وإياكم بما علمنا وعلمنا ما ينفعنا

شكرا لمرورك أخي كيماس وفقنا الله وإياكم لكل ما يحب ويرضى

سعيد بمرورك وتعليقك أخي الكريم 1) ناقشت قبل ذلك موضوع الحديث والقديم المتمثل في 2003 و 2007 2) وضعت حماية لتوضيح الأماكن التي يجب حمايتها والتي لا يجب حمايتها مسموح للمستخدم تغيير اسم المديرية والمدرسة والإدارة وأسماء المدرسين وأسماء الفصول وأسماء مربعات الإشراف وكل المتغيرات مسموح للمستخدم تغييرها لأن هذه الخلايا ليست محمية وإنما المحمي هو الخلايا غير القابلة للتعديل والتي لا يلزم المستخدم تغييرها 3) لا يوجد مشكلة في أن يبدأ العمل لدى أي مستخدم في أي يوم وبأي عدد من الحصص ما قمت به هو العمل الذي يمكن للجميع استعماله وبالنسبة لك اترك يوم السبت فارغا واترك الحصة 8 و9 فارغة ولن يؤثر ذلك على عمل البرنامج 4) لايوجد مشكلة فأسماء الفصول من الكتغيرات وسمي فصولك كما تشاء 5) أي قائمة منسدلة؟ فلا يوجد غير أسماء المدرسين والتي تأخذ بياناتها من الجدول الكبير وقائمة الفصول والتي تأخذ بياناتها من البيانات على يسار الجدول الكبير وقائمة مربعات الإشراف وهي أيضا من الخلايا على يسار الجدول الكبير وقائمة ايام الأسبوع وهي محددة سلفا سعيد جدا بتعلقاتك وأتمنى أن أكون وفقت في توضيح ما كان غامضا وبالنسبة للحماية فيوجد إضافة من تصميمي لمعرفة كلمة مرور أوراق العمل وإن كنت لا تحتاج هذه الإضافة فكلمة المرور ظاهرة في الكود وهذا لا يخفى على مبتدئ فما بالك بمبرمج إكسل تحياتي للجميع سبقت الإجابة عن سؤال مثل هذا (فك الحماية) فيما سبق

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

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

سعيد بمرورك وتعليقك أخي الكريم 1) ناقشت قبل ذلك موضوع الحديث والقديم المتمثل في 2003 و 2007 2) وضعت حماية لتوضيح الأماكن التي يجب حمايتها والتي لا يجب حمايتها مسموح للمستخدم تغيير اسم المديرية والمدرسة والإدارة وأسماء المدرسين وأسماء الفصول وأسماء مربعات الإشراف وكل المتغيرات مسموح للمستخدم تغييرها لأن هذه الخلايا ليست محمية وإنما المحمي هو الخلايا غير القابلة للتعديل والتي لا يلزم المستخدم تغييرها 3) لا يوجد مشكلة في أن يبدأ العمل لدى أي مستخدم في أي يوم وبأي عدد من الحصص ما قمت به هو العمل الذي يمكن للجميع استعماله وبالنسبة لك اترك يوم السبت فارغا واترك الحصة 8 و9 فارغة ولن يؤثر ذلك على عمل البرنامج 4) لايوجد مشكلة فأسماء الفصول من الكتغيرات وسمي فصولك كما تشاء 5) أي قائمة منسدلة؟ فلا يوجد غير أسماء المدرسين والتي تأخذ بياناتها من الجدول الكبير وقائمة الفصول والتي تأخذ بياناتها من البيانات على يسار الجدول الكبير وقائمة مربعات الإشراف وهي أيضا من الخلايا على يسار الجدول الكبير وقائمة ايام الأسبوع وهي محددة سلفا سعيد جدا بتعلقاتك وأتمنى أن أكون وفقت في توضيح ما كان غامضا وبالنسبة للحماية فيوجد إضافة من تصميمي لمعرفة كلمة مرور أوراق العمل وإن كنت لا تحتاج هذه الإضافة فكلمة المرور ظاهرة في الكود وهذا لا يخفى على مبتدئ فما بالك بمبرمج إكسل تحياتي للجميع

سعيد بمرورك أخي الكريم ولكن هل تستعمل أوفيس 2007؟؟ البرنامج يعمل على أوفيس 2007 أو أحدث

سعيد بمرورك أخي محمد وبانتظار ملاحظات الإخوة القائمين عليها