طارق محمود

السلام عليكم يمكن ان شاء الله

تفضل أخي الملف بأكواده المذكورة سابقا بعد تغيير البيانات الخاصة بأخري عامة final3.rar

السلام عليكم نعم يمكن ذلك سأقوم بذلك بعد إذن صاحب الملف

السلام عليكم تم الرد علي هذا في الموضوع علي الرابط التالي http://www.officena.net/ib/index.php?showtopic=35769

السلام عليكم أخي العزيز الرقم المضروب في المثال هو 8750 موجود في الخلية D8 ضع في خلية أخري ولتكن E9 المعادلة النالية =INT(D8/1000) ثم ضع في الخلية المجاورة لها D9 المعادلة النالية =D8-E9*1000

السلام عليكم أخي مراد بعد أن أرسلت ردي السابق فكرت ان البيانات كلها يفترض أنها محفوظة بالفعل في الورقة الثانية "كرونولوجيا الأحداث والمتغيرات" عدلت الكود الخاص بحدث معين ليقرأ من الورقة الثانية وليس من الورقة الأولي تفضل المرفق كرونولوجيا الأحداث والمتغيرات لموظفي الشركة6.rar

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

السلام عليكم ألف ألف مبروك لقد أشرقت الأرض وازدادت وتلألأت أنواراً من حولنا فتسائلت ما سر هذا الجمال فإذ بخبر قدوم مولودكِ / حسام الدين دعواتي بأن يكون من مواليد السعادة وأن يرزقك الله ووالده بره وصلاحة بالنسبة لسؤالك لم أنتبه إليه فدخولي للإنترنت قليل نسبيا سوف أراه الآن إن شاء الله

السلام عليكم أخي العزيز صباح بعد إذن أخي العزيز وأستاذنا : بن علية خاصية البحث في المنتدى لاتظهر ؟؟ سوف أراسل المهندس محمد طاهر مدير الموقع في هذا وطبعا يمكن نسخ القيمة الموجودة في الخلية المدمجة الى متغير معين فبل الغاء الدمج يمكنك حفظها في المتغير x والذي سيحتفظ بالقيمة ورقم السطر ورقم العمود غير الكود كالتالي Sub Unmerge() Dim myRange As Range Set myRange = Worksheets("Sheet1").Range("A1:M30") Dim x(30, 13) As Variant For Each cel In myRange r = cel.Row c = cel.Column x(r, c) = cel.Value cel.Unmerge Next Range("A1").Select End Sub

السلام عليكم أخي المعتصم بعد إذن أخي العزيز وأستاذنا : بن علية cel حسب السطر For Each cel In myRange هي جزء من myRange والذي تم تعريفه في أول الكود علي أنه مدي Range وعناصر المدي Range لابد ان تكون خلايا

السلام عليكم أخي العزيز تم تسمية المدي في العمود N في كلا من الورقتين المطلوبتين باسم my_Rang1 ، my_Rang2 ثم باستخدام الدالة RANK فهي أوتوماتيكيا تعمل ماتطلبه ، أنظر المرفق كنترول الامتحانات4.rar

السلام عليكم أخي العزيز إستخدم الدالة VLOOKUP

السلام عليكم أهلا ومرحبا بك أخي الكريمبين إخوانك أنظر المرفق وفيه (1) عمل المطلوب في ورقة 2 بإستخدام الدالة VLOOKUP (2) تنسيق شرطي لإخفاء النتائج إن كانت الخلية الأولي ليس بها رقم او بها رقم غير موجود بالورقة الأولي تفضل المرفق قاعدة بيانات2.rar

آمين آمين آمين آمين جزاك الله خيرا اخي يحي

السلام عليكم يمكنك إضافة سطرين للكود بعد سطر أمر For مباشرة وهما ddd = "المدي المتاح لنقل البيانات غير فارغ " & Chr(10) & "أفرغ المدي أولا ثم إنقل البانات" If s > 20 Or s1 > 36 Or s2 > 52 Or s3 > 64 Then MsgBox (ddd): Exit Sub ليكون الكود كالتالي ... For i = 6 To 10 ddd = "المدي المتاح لنقل البيانات غير فارغ " & Chr(10) & "أفرغ المدي أولا ثم إنقل البانات" If s > 20 Or s1 > 36 Or s2 > 52 Or s3 > 64 Then MsgBox (ddd): Exit Sub If sheet1.Cells(i, "d") <> 0 Then sheet2.Cells(s, "e") = sheet1.Cells(i, "c") sheet2.Cells(s, "g") = sheet1.Cells(i, "d") s = s + 1 End If ...

مرفق الملف وبه الكود المعدل Book1-2.rar

السلام عليكم أخي العزيز أولا إوقف تفعيل مسح البيانات القديمة السطر الثالث من الكود sheet2.Range("e6:h64").ClearContents ثانيا ضع متغيرات أخري تعد البيانات الموجودة في كل منطقة لتغير بداية وضع البيانات s , s1 , s2 , s3 سيكون الكود كالتالي بعد التعديل Sub ss() Application.ScreenUpdating = False 'sheet2.Range("e6:h64").ClearContents s = 6: s1 = 21: s2 = 37: s3 = 53 a = WorksheetFunction.CountA(sheet2.Range("e6:e20")) a1 = WorksheetFunction.CountA(sheet2.Range("e21:e36")) a2 = WorksheetFunction.CountA(sheet2.Range("e37:e52")) a3 = WorksheetFunction.CountA(sheet2.Range("e53:e64")) s = s + a s1 = s1 + a1 s2 = s2 + a2 s3 = s3 + a3 For i = 6 To 10 If sheet1.Cells(i, "d") <> 0 Then sheet2.Cells(s, "e") = sheet1.Cells(i, "c") sheet2.Cells(s, "g") = sheet1.Cells(i, "d") s = s + 1 End If If sheet1.Cells(i, "e") <> 0 Then sheet2.Cells(s1, "e") = sheet1.Cells(i, "c") sheet2.Cells(s1, "h") = sheet1.Cells(i, "e") s1 = s1 + 1 End If If sheet1.Cells(i, "f") <> 0 Then sheet2.Cells(s2, "e") = sheet1.Cells(i, "c") sheet2.Cells(s2, "g") = sheet1.Cells(i, "f") s2 = s2 + 1 End If If sheet1.Cells(i, "g") <> 0 Then sheet2.Cells(s3, "e") = sheet1.Cells(i, "c") sheet2.Cells(s3, "h") = sheet1.Cells(i, "g") s3 = s3 + 1 End If Next sheet2.Select Application.ScreenUpdating = True End Sub

السلام عليكم يجوز ان ذلك بسبب أن تتابع الأوامر في الكود يجعل الإكسل عند كل خطوة يقوم بأكثر من عملية (1) يقرأ من خلية الورقة الحالية (2) يذهب للورقة Sheet13 (3) يجعل قيمة خلية معينة فيها تساوي تلك الخلية (4) يرجع مرة أخري للورقة الحالية إذا غيرنا تتابع الأوامر كالتالي (1) يقرأ جميع الخلايا المطلوبة من الورقة الحالية ويسجلها في متغير مثلا x(a,b) (2) يذهب للورقة Sheet13 مرة واحدة ويضع القيم المقرؤة (3) يرجع مرة أخري للورقة الحالية جرب التعديل التالي Dim x(99, 99) As Variant For C = 3 To 8 For i = 0 To 19 x(R + i, C) = Cells(i + 6, C) Next i Next C For C = 3 To 8 For i = 0 To 19 Sheet13.Cells(R + i, C) = x(R + i, C) Next i Next C

السلام عليكم مرحبا بك اخي الكريم بين إخوانك تقصد تقليل حجم الكود يمكن استبداله بالتالي For C = 3 To 8 For i = 0 To 19 Sheet13.Cells(R + i, C) = Cells(i + 6, C) Next i Next C

السلام عليكم أخي العزيز لم يعد عندي 2007 لكن أعمل علي 2010 لكني أعتقد أنها نفس الطريقة من Page Layout ثم Page Setup ثم Backgroud

السلام عليكم رابط آخر للموضوع http://www.officena.net/ib/index.php?showtopic=150

السلام عليكم أخي الحبيب جزاك الله خيرا علي كاماتك الطيبة للأسف ليس لي حتي الآن وإن كنت أفكر في هذا لكن ليس لدي الوقت الكافي أنظر المرفق وبه شرح بسيط وبه أيضا الكود التالي Sub Shift2() ' حدث محدد Dim s_Hadth(99), h_Name(99), h_Reson(99), h_From(99), h_To(99), del_H(99) As Variant Sheets("الحالة اليومية للغيابات").Select Hadth_No = Cells(10000, 2).End(xlUp).Row - 2 If Hadth_No = Last_sh Then MsgBox (" Êã ÊÑÍíá ÌãíÚ ÇáÃÍÏÇË ãä ÞÈá " & Chr(10) & "áã íÊã ÊÑÍíá Ãí ÍÏË ÌÏíÏ"): Exit Sub '___________ READ _________________ One_Reason = [m16] For I = 1 To Hadth_No rrow = I + 2 + Last_sh s_Hadth(I) = Range("A" & rrow).Value h_Name(I) = Range("B" & rrow).Value & Range("C" & rrow).Value h_Reson(I) = Range("E" & rrow).Value h_From(I) = Range("F" & rrow).Value h_To(I) = Range("G" & rrow).Value Next I ' Write Sheets("كرونولوجيا حدث محدد").Select Range("E3:Y1503").ClearContents last_Row = [B10000].End(xlUp).Row For qq = 1 To Hadth_No For I = 3 To last_Row If Range("B" & I) & Range("C" & I) = h_Name(qq) Then 'Check if exist in sheet2 If h_Reson(qq) = One_Reason Then Range("B" & I).End(xlToRight).Offset(0, 1) = h_Reson(qq) Range("B" & I).End(xlToRight).Offset(0, 1) = h_From(qq) Range("B" & I).End(xlToRight).Offset(0, 1) = h_To(qq) GoTo 100 End If End If 100 Next I Next qq End Sub كرونولوجيا الأحداث والمتغيرات لموظفي الشركة5.rar

السلام عليكم أخي الحبيب / مراد القرفي مشكلة بسيطة إن شاء الله يم تغيير المتغير الدال علي الإسم ليأخذ قيمة مركبة من الإسم واللقب هذه هي التعديلات بالكود Sub Shift() Dim s_Hadth(99), h_Name(99), h_Reson(99), h_From(99), h_To(99), del_H(99) As Variant .. .. '___________ READ _________________ For i = 1 To Hadth_to_shft rrow = i + 2 + Last_sh s_Hadth(i) = Range("A" & rrow).Value h_Name(i) = Range("B" & rrow).Value & Range("C" & rrow).Value h_Reson(i) = Range("E" & rrow).Value .. .. Next i ' Write .. .. .. For i = 3 To last_Row If Range("B" & i) & Range("C" & i) = h_Name(qq) Then 'Check if exist in sheet2 .. .. .. Next i .. .. Next qq .. .. For qq = 1 To Hadth_to_shft .. .. For i = 1 To (Hadth_No - Hadth_to_shft) If h_Name(qq) = Cells(i + 2, 2) & Cells(i + 3, 2) Then x = x + 1 .. .. Next i End If Next qq 'Delete the Repeated Hadath If x = 0 Then GoTo 200 'No Delete If x = 1 Then d_x = Cells(del_H(1), 2): GoTo 150 For i = 1 To x d_x = d_x & Chr(10) & del_H(i) Next i 150 For i = 1 To x Range("B" & del_H(i) + 1 & ":H10000").Copy Range("B" & del_H(i)).PasteSpecial xlPasteValues Next i .. .. 200 End Sub أو جرب المرفق إن شاء الله تجد ماتريد كرونولوجيا الأحداث والمتغيرات لموظفي الشركة4.rar

السلام عليكم أخي الكريم بسيطة إن شاء الله يعلم الله أنني لم أنوه لهذا إلا لما لمسته فيك من الذكاء والتقدير بالنسبة لمشكلة العدد فيمكن حلها ببساطة إن شاء الله إذهب للورقة الثانية "كرونولوجيا وأرشيف الأحداث" إضغط Ctrl-End ليعطيك آخر خلية تحجزها في الملف وفي حالتنا هي: Y414 ثم قم بتعديل الخلية D1 التي بها العدد من المعادلة التي تعد الأحداث التي تم نقلها =COUNTA(E3:Y52)/3 إلي =COUNTA(E3:Y414)/3 أو للإحتياطي إجعل مداها أكبر مثلا =COUNTA(E3:Y60000)/3 لابأس ، مازلنا في حيز الورقة حتي يتسع لأقصي حدود الورقة

أخي العزيز تفضل المرفق عداد التذاكر.rar