اذهب الي المحتوي
أوفيسنا

بن علية حاجي

الخبراء
  • Posts

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

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

  • Days Won

    46

كل منشورات العضو بن علية حاجي

  1. السلام عليكم ورحمة الله عيدكم مبارك وسعيد، كل عام وأنتم بألف خير أعاده الله علينا بالخير واليمن والبركات... أخي الكريم، وأستسمح أخي العزيز محمود في تقديم الملف المرفق التالي حيث حاولت فيه المطلوب الجديد باستعمال خاصية التنسيقات الشرطية حسب عمود التاريخ إضافة إلى التنسيقات السابقة.... أتمنى أن يكون الملف المرفق ملبيا للمطلوب.... أخوكم بن علية --Trading Investments--.rar
  2. السلام عليكم ورحمة الله إنا لله وإنا إليه راجعون أخي الكريم سعيد، أعظم الله أجركم وغفر لميتكم... اللهم تغمدها برحمتك واعتق رقبتها من النار في هذا الشهر الكريم ووسّع لها قبرها واجعله روضة من رياض الجنة ومدّ لها في قبرها مدّ بصرها وألهم ذويها وأهلها الصبر والسلوان... وأجر الصابرين عظيم... أخوك بن علية
  3. السلام عليكم ورحمة الله أخي الكريم، بعض التعديلات تمت على ترتيب أوراق المستند (لأجل الإحصائيات) ثم تعديلات أخرى على الكود (إضافة + ترتيب بين كود الإحصائيات والترقيم التسلسلي)... الكل في الملف المرفق... أخوك بن علية يوسف ترحيل.rar
  4. السلام عليكم ورحمة الله أخي الكريم، أعتقد أن الخلل في السطر For k = 1 To 6 من المفروض أن يكون : For k = 1 To 7 وهذا حسب ما لاحظت في كود عمل أرقام التسلسل في شيتات الترحيل... والسطران : rrw = Sheets(J).[A3000].End(xlUp).Row و y = Sheets(k).[A3000].End(xlUp).Row - 4 ألا ينبغي أن يكونا : rrw = Sheets(J).[B3000].End(xlUp).Row و y = Sheets(k).[B3000].End(xlUp).Row - 4 لست أدري إن كانت هذه الملاحظات تصحح الخلل لأنه دون ملف تجريبي لا يمكن معرفة موطن الخلل وحسن عمل الأكواد.... أخوك بن علية
  5. السلام عليكم ورحمة الله أخي الحبيب عبد الله، بورك لك في الموهوب، وشكرت الواهب، وبلغ أشده، ورزقت بره... أخوك بن علية
  6. السلام عليكم ورحمة الله أخي الكريم، هذا تعديل آخر على معادلات الصفيف في الملف المرفق... أخوك بن علية Book1_2.rar
  7. السلام عليكم ورحمة الله تقبل الله منا ومنكم كل أعمال الخير في هذا اليوم المبارك وفي هذا الشهر المبارك وفي غيرهما... أخي الكريم مصطفى، إليك بالملف المرفق مع المطلوب... أخوك بن علية --Trading Investments--.rar
  8. السلام عليكم ورحمة الله تقبل الله منا ومنكم صالح الأعمال بمزيد من الأجر والثواب... أخي الكريم هذه محاولة في الكود ولكن جعلت الترقيم التلقائي للتسلسل في العمود A انطلاقا من الخلية A5 ويمكنك التغيير فيه..... Sub ترحيل_فصول() ''' متغيرات بعدد الصفحات المطلوب الترحيل اليها Dim R As Integer, A As Integer, B As Integer, C As Integer, D As Integer, E As Integer, F As Integer ''' أسماء الصفحات المطلوب الترحيل اليها والمدى المطلوب مسح البيانات القديمة منه Sheets("1").Range("A5:DZ5000").ClearContents Sheets("2").Range("A5:DZ5000").ClearContents Sheets("3").Range("A5:DZ5000").ClearContents Sheets("4").Range("A5:DZ5000").ClearContents Sheets("5").Range("A5:DZ5000").ClearContents Sheets("6").Range("A5:DZ5000").ClearContents ''' عدد الصفوف العليا في الصفحات المنقول اليها البيانات A = 5: B = 5: C = 5: D = 5: E = 5: F = 5 Application.ScreenUpdating = False ''' بداية ونهاية صفوف الورقة المصدر For R = 5 To 5000 ''''''''''''''''''''''''''''''''''''''''''''''''''' ''تكرر الأسطر التالية لكل شيت يتم الترحيل فيه مع تغيير المتغيرات ''' رقم عمود المعيار وكلمة المعيار If Cells(R, 4) = "1" Then ''' عدد الأعمدة التى سيتم ترحيلها Range("A" & R).Resize(1, 9).Copy ''' سيتم اللصق في هذا الشيت Sheets("1").Range("A" & A).PasteSpecial xlPasteValues Application.CutCopyMode = False A = A + 1 End If If Cells(R, 4) = "2" Then Range("A" & R).Resize(1, 9).Copy Sheets("2").Range("A" & B).PasteSpecial xlPasteValues Application.CutCopyMode = False B = B + 1 End If If Cells(R, 4) = "3" Then Range("A" & R).Resize(1, 9).Copy Sheets("3").Range("A" & C).PasteSpecial xlPasteValues Application.CutCopyMode = False C = C + 1 End If If Cells(R, 4) = "4" Then Range("A" & R).Resize(1, 9).Copy Sheets("4").Range("A" & D).PasteSpecial xlPasteValues Application.CutCopyMode = False D = D + 1 End If If Cells(R, 4) = "5" Then Range("A" & R).Resize(1, 9).Copy Sheets("5").Range("A" & E).PasteSpecial xlPasteValues Application.CutCopyMode = False E = E + 1 End If If Cells(R, 4) = "6" Then Range("A" & R).Resize(1, 9).Copy Sheets("6").Range("A" & F).PasteSpecial xlPasteValues Application.CutCopyMode = False F = F + 1 End If Next MsgBox ("الحمد لله تـــم ترحيل الطالبات كل إلى فصلها ") For k = 1 To 6 y = Sheets(k).[A3000].End(xlUp).Row - 4 mssg = mssg & Chr(10) & Format(y, "00") & " Students to Sheet : " & k Next k MsgBox (" تم ترحيل عدد" & mssg) Range("a1").Select For J = 1 To 6 Sheets(J).[A5] = 1 rrw = Sheets(J).[A3000].End(xlUp).Row For Each cc In Sheets(J).Range("A6:A" & rrw) cc.Value = cc.Offset(-1, 0) + 1 Next cc Next J Application.ScreenUpdating = True End Sub ''''''''''''''''''''''''''''''''''''''''''''''''''''' أرجو أني وفقت في تعديل الكود.... أخوك بن علية
  9. السلام عليكم ورحمة الله تقبل الله منا ومنكم الصلاة والصيام والقيام وصالح الأعمال وجمعة مباركة لكل المسلمين.... أخي الكريم يوسف، لتصحيح الكود وعمله يكفي إضافة العبارة End If لكل If في الكود فيكون الكود في الأخير كما يلي: Sub ترحيل_فصول() ''' متغيرات بعدد الصفحات المطلوب الترحيل اليها Dim R As Integer, A As Integer, B As Integer, C As Integer, D As Integer, E As Integer, F As Integer ''' أسماء الصفحات المطلوب الترحيل اليها والمدى المطلوب مسح البيانات القديمة منه Sheets("1").Range("A5:DZ5000").ClearContents Sheets("2").Range("A5:DZ5000").ClearContents Sheets("3").Range("A5:DZ5000").ClearContents Sheets("4").Range("A5:DZ5000").ClearContents Sheets("5").Range("A5:DZ5000").ClearContents Sheets("6").Range("A5:DZ5000").ClearContents ''' عدد الصفوف العليا في الصفحات المنقول اليها البيانات A = 4: B = 4: C = 4: D = 4: E = 4: F = 4 Application.ScreenUpdating = False ''' بداية ونهاية صفوف الورقة المصدر For R = 5 To 5000 ''''''''''''''''''''''''''''''''''''''''''''''''''' ''تكرر الأسطر التالية لكل شيت يتم الترحيل فيه مع تغيير المتغيرات ''' رقم عمود المعيار وكلمة المعيار If Cells(R, 4) = "1" Then ''' عدد الأعمدة التى سيتم ترحيلها Range("A" & R).Resize(1, 9).Copy ''' سيتم اللصق في هذا الشيت Sheets("1").Range("A" & A).PasteSpecial xlPasteValues Application.CutCopyMode = False A = A + 1 End If ''''''''''''''''''''''''''''''''''''''''''''''''''''' If Cells(R, 4) = "2" Then Range("A" & R).Resize(1, 9).Copy Sheets("2").Range("A" & B).PasteSpecial xlPasteValues Application.CutCopyMode = False B = B + 1 End If ''''''''''''''''''''''''''''''''''''''''''''''''''''' If Cells(R, 4) = "3" Then Range("A" & R).Resize(1, 9).Copy Sheets("3").Range("A" & C).PasteSpecial xlPasteValues Application.CutCopyMode = False C = C + 1 End If ''''''''''''''''''''''''''''''''''''''''''''''''''''' If Cells(R, 4) = "4" Then Range("A" & R).Resize(1, 9).Copy Sheets("4").Range("A" & D).PasteSpecial xlPasteValues Application.CutCopyMode = False D = D + 1 End If ''''''''''''''''''''''''''''''''''''''''''''''''''''' If Cells(R, 4) = "5" Then Range("A" & R).Resize(1, 9).Copy Sheets("5").Range("A" & E).PasteSpecial xlPasteValues Application.CutCopyMode = False E = E + 1 End If ''''''''''''''''''''''''''''''''''''''''''''''''''''' If Cells(R, 4) = "6" Then Range("A" & R).Resize(1, 9).Copy Sheets("6").Range("A" & F).PasteSpecial xlPasteValues Application.CutCopyMode = False F = F + 1 End If ''''''''''''''''''''''''''''''''''''''''''''''''''''' Next MsgBox ("الحمد لله تـــم ترحيل الطالبات كل إلى فصلها ") Application.ScreenUpdating = True End Sub ''''''''''''''''''''''''''''''''''''''''''''''''''''' والله أعلم أخوك بن علية
  10. السلام عليكم ورحمة الله تقبل الله منا ومنكم الصلاة والصيام والقيام وصالح الأعمال... أخي الكريم، أستأذن من أخي الكريم والحبيب عبدالله في تغيير طفيف على أحد أكواده في الملف حسب طلبك ... أرجو أني وفقت في ذلك وإن لم يكن كذلك فأرجو من أخي عبدالله التدخل لعمل المطلوب... أخوكم بن علية اعداد تقارير مدرسية.rar
  11. السلام عليكم ورحمة الله أخي الكريم إبراهيم، إن الدالة DATE تحتاج إلى وسائط ثلاث، الأول: رقم السنة - الثاني : رقم الشهر - الثالث : رقم اليوم وفي المعادلة المستعملة في الملف الخاصة ببداية الشهور تجد فيها : =DATE($B$4;ROW($A1);1) * رقم السنة : مضمون الخلية B4 (المثبتة) * رقم الشهر : استعملت فيه الدالة ROW التي تعطي رقم السطر لخلية معينة واخترت الخلية A1 والتي يهمني فيها الرقم 1 (الذي سيمثل رقم الشهر الأول من السنة) أما الحرف A فهو غير مهم وكان بالإمكان اختيار أي خلية أخرى B1 أو C1 أو غيرهما... وعند سحب المعادلة إلى الأسفل فإن (ROW($A1 تصبح (ROW($A2 لتعطي الرقم 2 (رقم الشهر الثاني) ثم (ROW($A3 لتعطي الرقم 3 (رقم الشهر الثالث) وهكذا... ويمكن أيضا استبدال (ROW($A1 بأي دالة أخرى تعطي تسلسلا للأرقام بطريقة تلقائية عند السحب إلى الأسفل مثل : (ROWS($1:1 أو غيرها... * رقم اليوم : الرقم 1 (ثابت) للإشارة إلى اليوم الأول من كل شهر بالنسبة لمعادلات نهاية كل شهر استعملت المعادلة : =DATE($B$4;ROW($A1)+1;0) والتي كانت في الأصل : =DATE($B$4;ROW($A1)+1;1)-1 والتي تعني بداية الشهر الموالي للشهر الحالي بحذف يوم واحد أي في الأخير تعطي نهاية الشهر الحالي... (الشهر الحالي أقصد به رقم الشهر الذي تعطيه العبارة (ROW($A1 حسب مكانها بعد سحب المعادلة)... والله أعلم أخوكم بن علية
  12. السلام عليكم ورحمة الله تقبل الله منا ومن المسلمين جميعا الصلاة والصيام والقيام وصالح الأعمال... أخي العزيز محمود، والله ما فهمته من العنوان -ما هو بين قوسين- "ادراج بدايه الشهور ونهايتها" أن الأخ الكريم يريد تاريخ أول من كل شهر وتاريخ آخر يوم منه بوساطة المعادلات أو الأكواد (مع تفضيله لكليهما)... والله أعلى وأعلم أخوك بن علية
  13. السلام عليكم ورحمة الله تقبل الله منا ومنكم الصلاة والصيام والقيام وصالح الأعمال.... أخي الكريم، هذه محاولة بالملف المرفق بالمعادلات والكود (كود بسيط) حسب الطلب... أخوك بن علية تاريخ بداية ونهاية الشهور.rar
  14. السلام عليكم ورحمة الله أخي الكريم، الظاهر أنه لا الطريقة التي اقترحتها عليك ولا الكود الذي وضعه أخي الحبيب أبو حنين لم يُجديا معك نفعا أو أنك لم تعرف طريقة استعمالهما... أرفق ملفا تضع فيه المطلوب بمثال من عندك... مع تحديد (الأوفيس+لغة الأوفيس) الذي تستعمله لوضع (ربما) ملف تنفيذي يشرح العملية والطريقة المقترحة في رد سابق... أخوك بن علية
  15. السلام عليكم ورحمة الله تقبل الله منا ومنكم الصلاة والصيام والقيام وصالح الأعمال... أخي الكريم أبو حنين لتحديد الخلية التي تلي آخر خلية غير فارغة في كود أخي الحبيب عبد الله (وأستسمحه في هذا التغيير) يكفي إضافة 1 في آخر المعادلة المسماة ROWEND فتكون كما يلي: =MAX(NOT(ISBLANK(Sheet2!$A$2:$A$60000))*ROW(Sheet2!$A$2:$A$60000))+1 وبالفرنسية تكون: =MAX(NON(ESTVIDE(Sheet2!$A$2:$A$60000))*LIGNE(Sheet2!$A$2:$A$60000))+1 وفي الكود الذي قدمته أيضا يمكن أيضا القيام بذلك بالفكرة نفسها فيكون الكود (وأستسمحك في التغيير) كما يلي: Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Cancel = True If Target.Column = 1 Then Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Select End If End Sub أخوك بن علية
  16. السلام عليكم ورحمة الله تقبل الله منا ومنكم الصلاة والصيام والقيام وصالح الأعمال.... أخي الكريم، لست أدري ما المشكلة التي جعلت الطلب الثاني لم يتم بطريقة غير صحيحة... جرب إذن الطريقة التالية باتباع الخطوات التالية: * مع أوفيس 2007 أو 2010 1- نفتح خصائص (options) الإكسيل حسب النسخة... 2- نختار خصائص متقدمة Advanced 3- نحذف العلامة من مربع "استعمال رموز النظام" أو Use system separators 4- اختيار "المسافة" لـ "رمز الألوف" Thousands separator (إن لم تكن موجودة أصلا) * مع أوفيس 2003 المراحل من 1 إلى 4 تكون كما يلي: 1- نفتح خصائص (options) من ثائمة أدوات Tools... 2- نختار القائمة International 3- نحذف العلامة من مربع "استعمال رموز النظام" أو Use system separators 4- اختيار "المسافة" لـ "رمز الألوف" Thousands separator (إن لم تكن موجودة أصلا) وفي الملف خاصتك نختار التنسيق المخصص للأرقام في الخلايا باستعمال ما يلي [$-2000000]# ##0 أرجو أن تعمل معك هذه الطريقة... أخوك بن علية
  17. السلام عليكم ورحمة الله تقبل الله منا ومنكم صالح الأعمال... أخي الكريم، أريد أن أنبه إلى أمر مهم إن الأرقام العربية هي الأرقام المتداولة في الكثير من المناطق أي هي الأرقام : 0، 1، 2، 3، 4، 5، 6، 7، 8، 9 وليست الأرقام (الهندية) المستعملة خاصة في المشرق... بالنسبة للمطلوب في موضوعك: الطلب الأول: تجده في الملف المرفق (مع تطبيق التنسيق على الأرقام حسب الطلب الثاني) Book1.rar الطلب الثاني: اخترت التنسيق المخصص التالي (اقتراح) على الأرقام [$-2000000]_-* # ##0_-;_-* # ##0-;_-* "-"??_-;_-@_- أخوك بن علية
  18. السلام عليكم ورحمة الله تقبل الله منا ومنكم الصلاة والصيام والقيام وصالح الأعمال.... أخي الكريم، محاولة في الملف المرفق علها تجيب المطلوب... أخوك بن علية تقريب رقم.rar
  19. السلام عليكم ورحمة الله تقبل الله منا ومنكم كل أعمال الخير... أخي الكريم، الخلل الذي جعل البحث ينحصر فقط في حوالي 30000 سطر (وبالضبط في 32767 سطر) راجع إلى التصريح ببعض المتغيرات بخاصية Integer التي تأخذ فيها هذه المتغيرات قيما صحيحة من -32767 إلى 32767 ولتصحيح الخلل تم تغيير التصريح لهذه المتغيرات (المتعلقة بالأسطر في كودين Kh_Find و kh_Add_Controls) من Integer إلى Long (أو Double) اللذان يسمحان بقيم كبيرة جدا (وقد اخترت الخاصية Long لاعتمادها أعدادا صحيحة)... وتم التصحيح في الملف المرفق.... أرجو أني وفقت في التصحيح والشرح... أخوكم بن علية Listbox Form5_1.rar
  20. السلام عليكم ورحمة الله تقبل الله منا ومنكم كل أعمال الخير... أختي الكريمة، هذا حل آخر بالمعادلات (مستوحاة من ملف أخي الحبيب جمال) مع بعض التعديلات... يكفي اختيار عدد الصفوف (1 أو 2) في الورقة 66 وسيتم التوزيع... أخوك بن علية توزيع بالمعادلات2.rar
  21. السلام عليكم ورحمة الله تقبل الله منا ومنكم الصلاة والصيام والقيام وصالح الأعمال.... أخي الكريم، إن كنت قد فهمت المطلوب فقد قمت بتعديل على الكود الذي اقترحته في ردي السابق ليناسب ما تريد الوصول إليه (وزيادة)... أخوك بن علية دفتر النقل.rar
  22. السلام عليكم ورحمة الله تقبل الله منا ومنكم الصلاة والصيام والقيام وصالح الأعمال.... أخي الكريم هذه محاولة بكود (كلاسيكي) بسيط في الملف المرفق مع إضافة لتعيين عدد الأسطر وعدد الأعمدة للمصفوفة... أرجو أني وفقت في بعض الحل... أخوك بن علية دفتر النقل.rar
  23. السلام عليكم ورحمة الله تقبل الله منا ومنكم الصلاة والصيام والقيام وصالح الأعمال... أخي الكريم تريد شرحا للمعادلة الثانية رغم أن شرحها موجود في طلبك وشرحك للطلب... غير أنني سأحاول شرحها بقليل من التفصيل... المعادلة المقصودة هي المعادلة الموجودة في الخلية Q46 (والتي تم نسخها إلى الأسفل): =IF(COUNTIF($P:$P;$P46)>=2;$R46*$O46/SUMPRODUCT(($P$46:$P$1000=$P46)*($R$46:$R$1000));$O46) هي معادلة شرطية باستعمال الدالة IF والتي تحتاج إلى 3 وسائط: الشرط ، النتيجة حالة تحقق الشرط ، النتيجة حالة عدم توفر الشرط * الشرط : يعبر عنه الجزء COUNTIF($P:$P;$P46)>=2 للتأكد إن كان مضمون الخلية P46 مكررا في العمود الإضافي (العمود P) * إذا كان الشرط محققا أي لما يتكرر (التشغيلة مع أمر الشغل) أكثر من مرة فإن "مبلغ سكاي" في الخلية O46 يتم تقسيطه حسب مجموع الأعداد (من العمود R) لهذه التشغيلة والذي تم باستعمال الجزء $O46/SUMPRODUCT(($P$46:$P$1000=$P46)*($R$46:$R$1000)) من المعادلة ثم ضرب هذا القسط في عدد أمر الشغل في الخلية R46 من السطر نفسه * وإذا كان الشرط غير محقق (لا يوجد تكرار لأمر الشغل مع التشغيلة) يتم نقل "مبلغ سكاي" إلى الخلية Q46 كما هو دون تغيير... وتلاحظ أني لم أضف الكثير على المطلوب وشرحه... أرجو أني قمت بتقريب الشرح للمعادلة المقترحة في الملف... (ويمكن فهم عمل المعادلة باستعمال خاصية Evaluation)... ومعذرة للتأخر في شرح المعادلة لأن الشرح يأخذ الكثير من الوقت مع صعوبته... وقد لاحظت أنك تطالب كثيرا في ردودك شرحا للمعادلات والأكواد وهو أمر لا يتسنى القيام به دائما ولذا اعذرنا جميعا في حالة عدم الرد على طلبك لهذه الشروح... أخوك بن علية
  24. السلام عليكم ورحمة الله تقبل الله منا ومنكم صالح الأعمال... أخي الكريم هذا حل آخر بمعادلة صفيف دائما مستوحاة من حل أخي الكريم محمود مع إمكانية نسخها في إجمالي الأيام الأخرى شرط أن يكون ارتفاع نطاق كل يوم ثابتا في كل يوم (عدد الأسطر نفسه لكل يوم)... أخوك بن علية 3_2.rar
  25. السلام عليكم ورحمة الله تقبل الله منا ومنكم كل أعمال الخير.... أخي الكريم، قمت بإضافة معادلة حسب المطلوب في ملف أخي الحبيب رجب في آخر مشاركة له... أتمنى أن تفي بالغرض المطلوب... أخوك بن علية آخر سعر2.rar
×
×
  • اضف...

Important Information