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

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

  1. ياسر خليل أبو البراء

    ياسر خليل أبو البراء

    المشرفين السابقين


    • نقاط

      11

    • Posts

      13165


  2. خالد الرشيدى

    خالد الرشيدى

    الخبراء


    • نقاط

      4

    • Posts

      889


  3. ا بو سليمان

    ا بو سليمان

    05 عضو ذهبي


    • نقاط

      2

    • Posts

      1469


  4. nedal_shami

    nedal_shami

    الخبراء


    • نقاط

      2

    • Posts

      119


Popular Content

Showing content with the highest reputation on 06/27/15 in مشاركات

  1. الأخ الكريم وسيم إليك المعادلة التالية علها تفي بالغرض =SUMPRODUCT(SUMIF(INDIRECT("'"&ROW(INDIRECT("1:15"))&"'!"&B$8&11),"<1E100")) أو هذه المعادلة =SUMPRODUCT(SUM(INDIRECT("'"&ROW(INDIRECT("1:15"))&"'!"&$B$8&11))) أو يمكنك استخدام معادلة الصفيف التالية لتحقيق الغرض ولكن لا تنسى هنا أن تضغط على Ctrl + Shift + Enter =SUM(N(INDIRECT("'"&ROW(INDIRECT("1:15"))&"'!"&$B$8&11))) إليك الملف المرفق فيه تطبيق المعادلة SUMIF & INDIRECT.rar
    2 points
  2. الأخ الغالي أبو حنين إليك هذا السطر يمكن إضافته في بدايات الكود بعد تعريف المتغيرات بحيث لو كانت الخلية فارغة يتم إظهار رسالة ثم الخروج من الإجراء If IsEmpty(Range("A1")) Then MsgBox "الخلية فارغة يرجى كتابة بيان بها", vbInformation: Exit Sub تقبل تحياتي
    2 points
  3. بسم الله الرحمن الرحيم كل سنة والجميع بخير لكل الأخوة الأفاضل بمناسبة الشهر الكريم اعاده الله عليكم باليمن والبركة وبمناسبة الشهر الكريم اهدى اليكم النسخة الأخيرة لبرنامج الميراث الشرعى على مذهب الجمهور ودعائكم لنا هو غايتنا الفرائض الربانية بالجداول الألكترونية new.zip معد البرنامج مهندس /خالد الطاهر حدادة
    1 point
  4. السلام عليكم تفقيط محدث بدالتي جديدتين واحدة للعربي ArbNum2Text وأخرى للإنجليزي EngNum2Text وتم الفصل بينهما بعد إن كانتا في دالة واحدة وذلك لوجود فرق في عدد المدخلات تصل إلى 4 مدخلات . والتحديث الآن تركز على تسهيل استخدام الدوال وخصوصا العربي مع استخدام المدخلات الإختيارية والتي كانت سابقا كلها مدخلات مطلوبة . لي ملاحظة واحدة فقط وتحتاج إلى آرائكم وهي تفقيط الكسر للدالة الإنجليزي وخصوصا أن الدالة تبدأ بالعملة أولا ثم تحويل الأرقام إلى حروف وعند الكسر يكون العكس ، الشيء الذي لا يروق لي .. فمن له دراية بالموضوع أرجو التكرم بتقديم مالديه من معلومات ولكم جزيل الشكر سلفا . الكود معمول لللأكسس والأكسل معا . تحياتي . الملفات المرفقة Num2Text20030725.zip ( 74.73ك ) عدد مرات التنزيل: 626
    1 point
  5. إخوتي الاعزاء فكرة اليوم التحكم بالوقت ( الساعة ) Time Control كلمات استدلالية اضافة وقت - طرح وقت - On Timer - DateAdd - نموذج - كود التطبيق جزء من تصور شامل اقتطفت لكم اليوم فكرة التحكم و السيطرة على الوقت حيث يحتوي النموذج F2 ( من أعلى اليمين) حقل غير ممكن لليوم يظهر اسم اليوم حقل غير ممكن لليوم يظهر تاريخ اليوم حقل غير ممكن للساعة يظهر الساعة ( 12 ساعة AM . PM ) (مفعل مع On Timer) حقل غير ممكن للساعة يظهر الساعة مع الثواني (مفعل مع On Timer) – 1000 تساوي ثانية واحدة ثم مجموعة ازرار وحقل غير منضم ( في الوسط ) حقل غير منضم ممكن للساعة يظهر قيمة افتراضية للوقت (الساعة الثامنة صباحا) (ساعة بداية الدوام) ( يمين من الاعلى للأسفل +) زر لاضافة دقيقة واحدة على قيمة الوقت ( الساعة ) في حقل الوقت الافتراضي زر لاضافة خمسة دقائق على قيمة الوقت ( الساعة ) في حقل الوقت الافتراضي زر لاضافة عشرة دقائق على قيمة الوقت ( الساعة ) في حقل الوقت الافتراضي زر لاضافة ستون دقيقة ( ساعة واحدة) على قيمة الوقت ( الساعة ) في حقل الوقت الافتراضي ( يسار من الاعلى للأسفل -) زر لطرح دقيقة واحدة على قيمة الوقت ( الساعة ) في حقل الوقت الافتراضي زر لطرح خمسة دقائق على قيمة الوقت ( الساعة ) في حقل الوقت الافتراضي زر لطرح عشرة دقائق على قيمة الوقت ( الساعة ) في حقل الوقت الافتراضي زر لطرح ستون دقيقة ( ساعة واحدة) على قيمة الوقت ( الساعة ) في حقل الوقت الافتراضي ( يمين أسفل الوسط) زر للعودة للوقت الافتراضي في حقل الوقت الافتراضي ( يسار أسفل الوسط) زر لتثبيت الوقت الحالي في حقل الوقت الافتراضي الاضافة و الطرح للوقت تتم باستخدام طريقة DateAdd حسب البنية التالية T1 = DateAdd("h", 1, T1) ولسان حال الكود يقول في الحقل T1 تعامل مع (n دقائق ) ( h ساعات) , (1 بالاضافة) (1- بالطرح) , من أصل قيمة الحقل T1 وكفى ... وفي التطبيق مزيد توضيح NA_TimeControl.rar
    1 point
  6. بسم الله الرحمن الرحيم الحمد لله ولا اله الا الله والله اكبر ربنا لك الحمد كما ينبغى لجلال وجهك ولعظيم سلطانك سبحانك لا علم لنا الا ما علمتنا سألت سؤال وهو ازاى اعرض كل التقارير من خلال نموذج رئيسى انا منمتش من امبارح لانى كنت محتاج جدا للموضوع ده وبفضل الله رب العالمين ربنا انعم وتفضل على بالوصول لنتيجة رائعه ونظرا لافضال اهلى المنتدى على ولاساتذتى الكرام لهم كل الشكر والتقدير اهدى عملى المتواضع هذا اليكم حتى تعم الفائده النموذج المرفق يحتوى على - صلاحيات مشتخدمين -صلاحيات استخدام العناصر لكل مستخدم على حده -البحث والفلترة والتظليل لنتائج البحث وظهورها بلون احمر ايا كان موقع الحروف والارقام والبحث متعدد ومتقدم -نموذج لعرض كل قاعدة البيانات من خلاله بكل سهوله وايضا من خلال هذا النموذج يمكن عمل تصدير لاى تقرير بجميع الصيغ كما يمكن معاية التقرير قبل الطباعه ثم طباعة التقرير اتمنى ان تجدوا ما يسركم وينفعكم ان شاء الله لعلم كل ما ورد فى المرفق حصرى لمنتادنا فقط لان تصميم القاعده بتلك الكيفية ومعالجة البيانات من بنات افكارى طبعا ادين بالفضل لكل استاذ جليل او اخ كريم تعلمت منه او على يديه سواء بطريق مباشر او غير مباشر المرفق عباره عن ملف تيكست به رابط تحميل من المدياي فاير File size: 2.73 MB =================================================================== READ IT.txt مثال شامل.rar
    1 point
  7. http://www.samysoft.net/fmm/fimnew/basmla/24235235.gif أسعد الله أوقاتكم بكل خير فيما يلي الدرس الواحد والثلاثون من الدورة المميزة مهارات اكسيل 2013 أتمنى لكم مشاهدة ممتعة ومفيدة دالة البحث VLOOKUP الجزء الثالث استخدام دالة VLOOKUP عبر أكثر من ورقة عمل ويتخلل الدرس تصحيح الأخطاء الناتجة عن دالة VLOOKUP انتظرونا غداً في الجزء الرابع من دالة VLOOKUP (استخدام دالة VLOOKUP المتداخلة لانشاء عمليات بحث معقدة ) لمشاهدة باقي دروس دورة الاكسيل 2013 المنشورة يرجى فتح ا لرابط التالي: دمتم بخير أخوكم م/نضال الشامي Google+ Twitter
    1 point
  8. السلام عليكم كل عام وانتم بخير استكمالا للموضوع الذى بدأه الاستاذ المبدع ياسر خليل فقد قمت ببرمجة نسخة مستقلة من مكتبة الاكواد (ملف تنفيذى لا يحتاج الاكسل) ومزودة بامكانيات اكبر للبحث والتصنيف بواسطة المجموعة او جزء من العنوان او الكود ... وكذلك يقوم بفتح ملفات الأمثلة المرفقة بواسطة زر يتم تفعيله اذا كان هناك ملف مرفق وكنت اتمنى ان استكمل الامثلة والاكواد لكن الوقت لم يسعفنى..... ارجو تجربته واخبارى عن اى اخطاء برمجية وسوف احاول استكمال الامثلة واضافة اكود جديدة ونشرها بعد التعديل رابط التحميل: http://www.bscenter.co/downloads/vbaforexcelcodes.rar
    1 point
  9. السلام عليكم ورحمة الله وبركاته يبارك لك الله في عمرك وصحتك وعلمك معلمي ياسر كما يقال منتحرمش منك ...............................................
    1 point
  10. أ. ياسر خليل شاكر متابعة حضرتك للموضوع ووصف محتواة بالكنوز جزاك الله خيراً تقبل فائق احترامى وتقديرى
    1 point
  11. أبي وحبيبي أبو يوسف لو أحببت الأمر وأردتني البحث فيه والمحاولة فيه لفعلت إن شاء الله .. ولكن عليك أن توضح أكثر ما هو الشكل المتوقع ... أريد الدقة في توضيح الفكرة حتى يمكنني البحث والتقصي تقبل تحياتي وكل عام وأنت بخير
    1 point
  12. السلام عليكم أخي الحبيب أبو البراء هي فكرة ومرت بمخيلتي اعتبرني لم أذكرها ما دمت لا تستسيغها..لا يوجد أب ديمقراطي يوافق أبناءه كهذا العجوز الذي يراسلك..كل ذلك من باب المحبة ...والسلام عليكم..
    1 point
  13. اخى واستاذى خالد ايه الحلاوه دى ياترى دى رشيدى الميزان ولا المراعى مننحرمش منك ابدا ياريس معلومات دسمه جدا صدقنى واشكرك اولا على ادراج اسمى ضمن الموضوع ولكنى مازلت اصر على اننى لم افهم هذه الداله جيدا الا الان ................................................. ولكن اريدك ان توضح للاخوه الافاضل كيفيه استخدام هذه الداله سواء فى البحث من ناحيه اليمين او فى البحث من ناحيه اليسار لاننى اعتقد ان الكثير لا يدرك هذه الميزه ........................................ تقبل نحياتى
    1 point
  14. بالفعل أ.علاء رسلان هى فكرة رائعة يمكن تطويعها لاكثر من استخدام ما سبق احدهما .............. أسال الله ان يجازى استاذى/ إبراهيم ابو ليله عنها خيراً
    1 point
  15. أخي الحبيب أبو يوسف صراحة لم أجري بحث بخصوص تلك النقطة ... لأنه في وجهة نظري حتى لو كان في الإمكان عمل ذلك ألن يكون الأمر مزعجاً ظهور رسالة ملتصقة بمؤشر الماوس ؟؟؟ أو لربما لم تصلني فكرتك بعد ..
    1 point
  16. تروق لى الفكرة الموضحة برقم 6 فى المزج الرائع بين vlookup & if و من بين طيات الشرح تتولد أفكار أخرى متعددة تجعل من الصعب ( ليس المستحيل ) أمرا سهلا و يسيرا و تمدنى بالكثير من الابتكار فى الفكر جزاك الله خيرا أخى الفاضل و أستاذى خالد الرشيدى دمت بخير و أعزك الله
    1 point
  17. باااااااااارك الله فيك وفي علمك
    1 point
  18. تفضل أخي الحبيب الجداول المحورية (الفيديو) الجداول المحورية ( ملف PDF)
    1 point
  19. أ. ابو سليمان المشكلة كما زكرت سابقاً انى اريد كمية معينة من البيانات فى صفحة واحدة وبالتالى صورة واحدة - ولكنى حرصت هذه المرة على وضوح الخط قدر الامكان _ وإن شاء الله فى الملف ال PDF سأهتم بذلك كثيراً تقبل تحياتى
    1 point
  20. فكــــــــــــــــــــــرة 6 / البحث بأكثر من شرط التطبيق بالمرفقات VLOOKUP-6.rar ................................................................... يتـــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــبع
    1 point
  21. عمل جميل مشوق ولا احلى نحن بانتظارك ... اعانك الله ووفقك لكل خير
    1 point
  22. تفضل وعلى نفس طريقتك في البحث ومن خلال الاستعلام وليس باستخدام الفلترة 1. ضع هذا التعبير كعمود جديد في الاستعلام Expr2: IIf([Forms]![for17]![إطار61]=1;[fid09] Is Not Null;IIf([Forms]![for17]![إطار61]=2;[fid09] Is Null;1=1)) ثم ضع 1- كقيمة في معيار هذا العمود 2. الحدث التالي Private Sub إطار61_AfterUpdate() Me.for18.Requery End Sub بالتوفيق
    1 point
  23. السلام عليكم ورحمة الله وبركاته جزاكم الله خيراً
    1 point
  24. بارك الله فيك اخى محمد على أهتمامك والحقيقة لم اقم بأى نشاط فيما يتغلق بزكاة المــــــــــــــــــــال بعد وأن كان موضوعه أسهل بكثير من علم الفرائض
    1 point
  25. جرب هذا التعديل Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row > 3 And Target.Column = 6 Then Dim Cell As Range Application.ScreenUpdating = False Rows("4:28").EntireRow.Hidden = False For Each Cell In Range("A4:A28") If IsEmpty(Cell) Then Cell.EntireRow.Hidden = True Next Cell Range("A" & Cells(Rows.Count, 1).End(xlUp).Row + 1).EntireRow.Hidden = False Range("F" & Cells(Rows.Count, 1).End(xlUp).Row).Select Application.ScreenUpdating = True End If End Sub تقبل تحياتي
    1 point
  26. بسم الله ما شاء الله أخي الحبيب الغالي المتمكن مختار ايه الجمال ده ... صراحة في منتهى الروعة والابداع والاختصار أنا صراحة اشتغلت على الكود الموجود وعدلت طبقاً لما طلبه الاخوة من مسار الحفظ وفتح الملف بعد التحويل .. بس كودك هو الأفضل والأيسر بلاشك
    1 point
  27. الأستاذ الميسانى شىء طبيعى ظهور هذا الخطأ لأن أنت فلتها بنفسك A1 فارغة طبق الكود على ملف الأخ الكريم Creation Sub PDFusingdialogbox() Dim Rng As Range Dim i As Variant Dim Fname As String Fname = "Elmisani" ' ضع الاسم اللى يعجبك i = Application.GetSaveAsFilename(Fname, "PDF Files (*.pdf), *.pdf") Set Rng = Sheets("ورقة1").Range(Cells(1, 1), Cells(Rows.Count, 6)) Application.ScreenUpdating = False Rng.Activate Selection.ExportAsFixedFormat Type:=xlTypePDF, FileName:=i, Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True Sheets("ورقة1").Range("A1").Select Application.ScreenUpdating = True End Sub هذا بالنسبة للملاحظة الأولى الثانية والثالثة جرب الحفظ حتى مليون مرة بالكود التالى هو هو اللى فوق بس بنلعب باسم الملف براحتنا Sub PDFusingdialogbox() Dim Rng As Range Dim i As Variant Dim Fname As String Fname = Left(ActiveWorkbook.Name, InStr(1, ActiveWorkbook.Name, ".", 1) - 1) & "(" & Format(Now, "DD-MM-YYYY-hhmmss") & ").pdf" i = Application.GetSaveAsFilename(Fname, "PDF Files (*.pdf), *.pdf") Set Rng = Sheets("ورقة1").Range(Cells(1, 1), Cells(Rows.Count, 6)) Application.ScreenUpdating = False Rng.Activate Selection.ExportAsFixedFormat Type:=xlTypePDF, FileName:=i, Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True Sheets("ورقة1").Range("A1").Select Application.ScreenUpdating = True End Sub اذا كنت تريد وضع الاسم بنفسك فى الصندوق الحوارى استخدم الكود التالى هو هو بس بنلعب بالاسم زى ما قلت لك Sub PDFusingdialogbox222() Dim Rng As Range Dim i As Variant Dim Fname As String Fname = "" i = Application.GetSaveAsFilename(Fname, "PDF Files (*.pdf), *.pdf") Set Rng = Sheets("ورقة1").Range(Cells(1, 1), Cells(Rows.Count, 6)) Application.ScreenUpdating = False Rng.Activate Selection.ExportAsFixedFormat Type:=xlTypePDF, FileName:=i, Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True Sheets("ورقة1").Range("A1").Select Application.ScreenUpdating = True End Sub بالنسبة للمرفق أعتذر الليلة للصلاة كل سنة وأنتم جميعا أقرب لله
    1 point
  28. أخي الكريم أحمد أبو زيزو أفضل إرفاق ملف للإطلاع عليه والعمل عليه إن أمكنني ذلك إن شاء الله
    1 point
  29. أخي الحبيب الغالي السباق بالخير مختار بارك الله فيك وجزيت خير الجزاء أخي الكريم أبو بهاء المصري .. لي عتاب بسيط .. يرجى ألا تكثر الطلبات في موضوع واحد .. ماذا يضرك إذا جعلت كل طلب في موضوع منفصل كي يجد الباحث فيما بعد بغيته إذا أراد البحث إليك الملف التالي عله يفي بالغرض (وإن كنت من أنصار التحديث والتجديد ومواكبة العصر) Sub GenerateRandom() Range("A10:A210").Formula = "=RandomNumbers(1,12)" End Sub Sub ClearRange() Range("A10:A210").ClearContents End Sub Public Function RandomNumbers(Lowest As Long, Highest As Long, Optional Decimals As Integer) Application.Volatile If IsMissing(Decimals) Or Decimals = 0 Then Randomize RandomNumbers = Int((Highest + 1 - Lowest) * Rnd + Lowest) Else Randomize RandomNumbers = Round((Highest - Lowest) * Rnd + Lowest, Decimals) End If End Function يمكنك توليد أرقام بها كسور وليست أرقام صحيحة فقط من خلال التعديل في المعادلة =RandomNumbers(1,12,1) كل عام وأنتم بخير Random Numbers YasserKhalil.rar
    1 point
  30. الأخ الفاضل غسان العبيدى عمل جميل وفكرة جيدة واسمح لى ان اضيف عليها طلب الاخ الفاضل الميسانى وهو نفس الفورم السابقة مع اضافة 1- عنوان ثابت 2- مربع ادخال نص متغير العرض 3- زر تمرير متغير الارتفاع 4- بالاضافة الى تعديل صورة الخلفية 5- ايضا هناك إضافة صغيرة للتحكم فى الحد الادنى لأبعاد الفورم Resize Userform تغيير حجم اليوزرفورم بالماوس.rar
    1 point
  31. وعليكم السلام ورحمة الله وبركاته. بعد دمج المراسلات في الورد وحفظ ملف الناتج، فإن هذا الملف مستقل تماما، وليس فيه أكواد، ولذلك لا يمكن جعله يتحدث تلقائيا مع تغيير البيانات في اكسل. الحل المعروف، أن تحتفظ بملف دمج المراسلات، وتعيد بناء الملف من جديد بعد تحديث بيانات الأكسل. والحل الآخر: أن تكون الشهادات في ملف الاكسل في ورقة أخرى في نفس ملف الاكسل، فعند ذلك تجد البيانات تتحدث تلقائيا، وأيضا يمكنك ضم البيانات في أكثر من ورقة.
    1 point
  32. الحلقة الرابعة عشر ***************** السلام عليكم ورحمة الله وبركاته وحشتكم !! أكيد لا .. لأني لو وحشتكم كنتو فتحتوا الباب وسألتوا عليا .. عموما إنتو وحشتوني ، وعشان وحشتوني هاقدم لكم حلقة جديدة يمكن تفتكروني. النهاردة هتكلم عن حاجة ناس كتير شرحوها ، وشرحوها بشكل ممتاز ، ودا خلاني مش عارف أشرح إزاي ، لأن اللي شرحوها وفوا شرحها صراحة .. هنتكلم عن الحلقات (بس مش حلقات افتح الباب) الحلقات اللي هنتكلم عنها الحلقات التكرارية ، ومن اسمها هي عبارة عن حلقات بتتكرر (إضافة عظيمة!) اسمها بالإنجليزي Loops ودي مهمة جداً في عالم الأكواد ، محدش يقدر يستغنى عنها تقريباً .. نفترض إني دخلت الفصل (بما إني معلم) ولسه دي أول مرة أتعرف على الطلبة اللي في الفصل ..يا ترى أنا عندي استعداد أخلى طالب طالب يقوم وأنا أقوله قول اسمك والطالب اللي بعديه قول اسمك .. أعتقد إن ريقي هينشف ودماغي هتصدع ودا طبعا مش يرضيكم (مش كدا ولا ايه) ..أنا من النوع الكسول فكل اللي هعمله هعمل تكرار من أول طالب في الفصل لآخر طالب ، وأعطي الأمر مرة واحدة .. من أول طالب إلى آخر طالب قووووول اسمك يا حبيبي الطالب التالي هو دا شكل الحلقة التكرارية .. نبرمجها بلغة الـ VBA ... هنقول إن الفصل فيه 60 طالب (معلش دا واقع الفصول في مصر) .. نقطة مهمة مننساش إن الطالب متغير مش ثابت ، فنرمز للطالب المتغير بالرمز X مثلاً ... Sub Loops() Dim X As Long For X = 1 To 60 'Say your name Next X End Sub طبعاً الكود دا شوية له علاقة بالبرمجة وشوية هتش .. ايه اللي هنعمله ..زي ما اتعودنا (دايما) إننا نعرف المتغير .. ونركز في السطر الثاني بدأ بكلمة For متبوعة باسم المتغير اللي هو X وبعدين علامة يساوي عشان نحدد قيمة X المتغيرة (أو الطالب المتغير) وهنا القيمة ليها بداية وليها نهاية (كل شيء له بداية ونهاية) وبيفصل بين البداية والنهاية حرف الجر To وفي آخر الحلقة التكرارية جملة Next X وممكن نقول Next ونسكت ، ومحرر الأكواد هيفهم لوحده .. بس أنا تقليدي شويتين فخلينا نكتب المتغير ، عشان الكود ممكن يكون فيه أكتر من حلقة تكرارية .. الجزء المهم هو الجزء اللي بين السطرين ، وهو دا الأمر المطلوب تكراره ، السطر اللي هنا مجرد تعليق وهتش وملوش علاقة بالبرمجة .. بس حبيت أقرب لكم الفكرة بأسلوب جديد.. كدا لما أنفذ الكود اللي فات ، كل اللي عملته إني أعطيت الأمر مرة واحدة وبس (وأنا حاطط رجل على رجل ... الدورة تلف على طالب طالب ، ويقول اسمه ، ولما يخلص ، الدورة تنتقل للطالب اللي بعديه وهكذا إلى أن ينتهي الطلاب ، ولما الـ 60 طالب يخلصوا ..يتم إيقاف تنفيذ الكود... ناخد أول مثال بجد عشان نقدر نتعلم إزاي نستفيد من الحلقات التكرارية :: لنفترض أننا عايزين نرقم النطاق A1:A10 بالأرقام من 1 إلى 10يعني الخلية A1 = 1 والخلية A2=2 وهكذا ..طبعا الموضوع بسيط جدا Sub NumberRange() Range("A1").Value = 1 Range("A2").Value = 2 Range("A3").Value = 3 Range("A4").Value = 4 Range("A5").Value = 5 Range("A6").Value = 6 Range("A7").Value = 7 Range("A8").Value = 8 Range("A9").Value = 9 Range("A10").Value = 10 End Sub كود في منتهى الروعة .. شايف حسام بيضحك ويقولي عايزك ترقم النطاق من A1:A100 (وابتسم ابتسامة فيها شماته !!) نفكر شوية .. بقول نفكر شوية (بلاش تكمل الحلقة غير لما تبص في الكود وتفكر شوية .. فكر شوية واكسب التوفير في الوقت والجهد) ايه المشترك في أسطر الكود .. وايه المختلف .. المتشابه في كل الأسطر Range("A ").Value = والمختلف هو الرقم بعد حرف الـ A ، والقيمة اللي بعد علامة يساوي .. في السطر الأول الرقم اللي بعد حرف الـ A هو 1 ، والقيمة بعد علامة يساوي بردو 1 ، ونفس الكلام مع السطر رقم 2 ، ورقم 3 وهكذا يبقا أول حاجة تفكر فيها إنك المختلف أو المتغير أو الشيء الغير ثابت تضعه في متغير ، ودا لأنه مش ثابت ومتغير .. فنضع متغير باسم X مثلاً ونعمل حلقة تكرارية من 1 إلى 10 (دي القيم اللي هيحملها المتغير) Sub NumberRange() Dim X As Long For X = 1 To 10 Range("A" & X).Value = X Next X End Sub نفس الكود اللي شرحناه من شوية ، الاختلاف في السطر اللي بين سطري التكرار .. الحلقة هتدور 10 مرات ، وفي كل مرة المتغير X بيحمل قيمة مختلفة (نرررررركز في الجزئية اللي جاية لأنها مهمة جداً جداً ) مش هنفذ الكود مرة واحدة .. سنقوم بعملية التنفيذ واحدة واحدة ، اللي مستعجل يروح ينفذ الكود مرة واحدة ، واللي مش مستعجل أنا معاه ..عشان يعرف حاجة مش هيعرفها الأخ المستعجل ... ضع مؤشر الماوس في أي مكان في الكود .. جميل >> اضغط F8 من لوحة المفاتيح ، وجمد قلبك وقول يا رب .. لاحظت ايه يا عبد المحسن؟ عبد المحسن ناااااااام مني (الله يسامحك) ..عبد المحسن : شايف الدنيا صفرا ليه ، هو فيه عاصفة النهاردة كمان؟ .. رديت عليه : لا يا عبد المحسن كمل نومك ، السطر الأصفر اللي ظهر ده سببه إننا ضغطنا F8 .. ودا فايدته إننا هنقوم بعملية التنفيذ واحدة واحدة .. سطر سطر .. السطر الأصفر على أول سطر في الكود Sub NumberRange() اضغط F8 مرة تانية ، ايه اللي حصل انتقل السطر الأصفر للسطر التالت ، طيب والسطر التاني يا معلم .. ملوش لازمة !!! أكبر خطأ إنك تعتقد إنه ملوش لازمة ، لما ضغطنا F8 للمرة التانية ، محرر الأكواد خزن في الذاكرة كل المتغيرات الموجودة في الكود عايز تتأكد من كلامي ، حرك مؤشر الماوس اللي على شكل حرف I (فيه شرطة فوق وشرطة تحت) حرك الماوس من غير ما تدوس كليك .. واقف على المتغير X هتلاقي تلميح في مستطيل صغير بيقولك المتغير X=0 ، دي كدا القيمة المبدئية للمتغير ... لما تضغط F8 للمرة التالتة ، روح شوف قيمة X مرة تانية هتلاقي قيمة X=1 (ايه اللي خلاها 1 مش كانت صفر من لحظة ) اللي حصل إننا انتقلنا من السطر For X = 1 To 10 والسطر دا هيبدأ في عمل الحلقة التكرارية اللي بنقول عليها ، والحلقة بدايتها 1 زي ما حددنا (وطبعاً ممكن نغير نقطة البداية يا شباب .. مش شرط 1) حرك مؤشر الماوس من غير ما تدوس على المتغير X في السطر المظلل بالأصفر Range("A" & X).Value = X هنلاقي زي ما قلت إن X =1 يعني محرر الأكواد هيعمل ايه دلوقتي ، هيشيل كل X ويحط مكانه القيمة 1 ، فيصبح السطر في الذاكرة بهذا الشكل Range("A1").Value = 1 لحد كدا تمام التمام ، صغر محرر الأكواد بحيث تكون ورقة العمل ظاهرة بالنسبة لك واتأكد إن النطاق A1:A10 فارغ ليس به أي بيانات ، وركز في ورقة العمل ، واضغط F8 عشان تنقل السطر الأصفر إلى هذا السطر ، ولاحظ ورقة العمل Next X لاحظت يا منصور الخلية A1 وضعت فيها القيمة 1 ، نخلي بالنا إن السطر الأصفر بيتم تنفيذه بعد الخروج منه ، فلما خرجنا من السطر تم تنفيذ الأمر وأعطى القيمة 1 للخلية A1 .. اضغط F8 مرة أخرى ، ونلاحظ إن السطر الأصفر انتقل للسطر اللي قبليه ، مش لبداية الحلقة التكرارية ، يعني ببساطة السطر اللي بيحدد بداية الحلقة ونهايتها بيعدي عليه مرة واحدة فقط .. أما سطر الأمر والسطر اللي فيه كلمة Next بيبدل السطر الأصفر عليهم... نبص دلوقتي على قيمة المتغير X هنلاقيها بقت 2 فيتم تنفيذ السطر بمجرد الضغط على F8 ويضع القيمة 2 في الخلية A2 وهكذا ..جرب واضغط F8 وفي كل مرة شوف قيمة المتغير X وشوف النطاق A1:A10 في كل مرة أول ما توصل قيمة المتغير X إلى الرقم 10 تتوقف الحلقة التكرارية ، وينتقل السطر الأصفر لجملة End Sub .. وينتهي عمل الكود .. عارف إني طولت في النقطة اللي فاتت ، بس كان لازم أطول فيها ، عشان أنا فاضي ومفيش ورايا شغل ، فقلت أصدعكم شوية!! ننتقل لمثال آخر --------------- عشان نقدر نفهم إزاي نستفيد من الحلقات التكرارية .. عايزين نعد الاسم (أحمد) في النطاق A1:A10 نفترض إني عندي الأسماء دي في النطاق A1:A10 أحمد ياسر سليم حسام عيسى أحمد أحمد خليل عبد الله أحمد المطلوب : نشوف الاسم (أحمد) كم مرة تم تكراره .. المعطيات : استعن بالله ثم بالحلقة التكرارية .. الفكرة : هنعمل اختبار صغير بقاعدة IF وهنقول لو قيمة الخلية بتساوي "أحمد" .. زود المتغير Counter بقيمة واحد Sub CountName() Dim X As Long Dim Counter As Long For X = 1 To 10 If Range("A" & X).Value = "أحمد" Then Counter = Counter + 1 Next X MsgBox Counter End Sub عملنا متغير جديد باسم Counter عشان لما يتحقق الشرط ويلاقي الاسم "أحمد" يقوم يخلي المتغير Counter يساوي نفسه + 1 طيب ليه يساوي نفسه ، عشان في كل مرة يلاقي أحمد قيمته هتتغير فلازم نضيف واحد لكل Counter جديد النتيجة في الآخر هتظهر في رسالة ، وهي 4 .. طيب نجرب نشيل الواحد في هذا السطر Counter = Counter + 1 لو شيلنا الواحد هتكون النتيجة 0 ، لأن المتغير قيمته المبدئية صفر ، فلما يتحقق الشرط مش هيزيد المتغير إلا لما نضيف واحد في كل مرة يتحقق الشرط. هناخد مثال آخر ---------------- عندنا درجات في النطاق A6:A15 ، عايزين نكتب ناجح أوراسب في الخلية المجاورة للدرجة ، لو الدرجة أكبر من أو يساوي 50 يبقا ناجح ، مكانش يكون راسب ... نخلي بالنا أنا غيرت بداية النطاق عشان الحلقة التكرارية بردو هتتغير بدايتها ونهايتها طبقاً للصفوف الجديدة 58 41 88 40 50 40 98 94 60 35 نجرب الكود التالي .. Sub LoopsTest() Dim X As Long For X = 6 To 15 If Cells(X, 1).Value >= 50 Then Cells(X, 2).Value = "ناجح" Else Cells(X, 2).Value = "راسب" End If Next X End Sub نلاحظ الحلقة التكرارية بدأت من 6 إلى 15 (ودا متغير للصفوف من الصف رقم 6 إلى الصف رقم 15) ووضعنا الشرط بين سطري الحلقة التكرارية ، لو الخلية اللي في الصف X والعمود الأول أكبر من أو يساوي 50 يقوم يعمل ايه؟ يضع القيمة النصية "ناجح" في الخلية اللي في العمود الثاني والصف X (نفس الصف بالطبع لأن قيمة X في الحالة دي هي هي نفس القيمة لأننا في نفس اللفة) .. إذا لم يتحقق الشرط قام بتنفيذ الجزء الثاني بأن يكتب النص "راسب" ثم إغلاق جملة IF بالجملة End IF ومننساش القفلة زي ما اتعودنا.. ننتقل لآخر مثال في الحلقة دي (عشان أنا تعبت وإنتو كمان أكيد تعبتو) في الأمثلة اللي فاتت عملنا حلقات تكرارية للصفوف .. واحد بيقولي طيب والأعمدة ملهاش نصيب في الدوخة اللي إحنا فيها دي .. أقوله أكيد ليها نصيب .. المطلوب إننا في الصف الرابع ، نكتب معادلة =COLUMN() بس في الأعمدة من العمود رقم 1 إلى العمود رقم 15 (A To O) نعقدها شوية ونقول في الأعمدة اللي رقمها فردي بس (الأعمدة اللي رقمها زوجي مش محتاجينها) يعني ببساطة عايزين نحط المعادلة في الأعمدة A C E G I K M O Sub ColumnsLoop() Dim X As Long For X = 1 To 15 Step 2 Cells(4, X).Formula = "=COLUMN()" Next X End Sub الحلقة التكرارية بدأت من العمود الأول حتى العمود رقم 15 (البداية والنهاية) معلومة جديدة Step 2 (دي معناها إننا هنقفز ..والقفز هيكون بمقدار 2 أي خطوتين) بدأنا بـ 1 فلما نقفز بمقدار 2 ، هنروح لرقم 3 ، أي أن المتغير سيكون رقم فردي في كل مرة 1 ، 3 ، 5 ، 7 ، 9 ، 11 ، 13 ، 15 (وهو دا المطلوب بالضبط) سطر الأمر فيه الخاصية Formula ودي عشان نقدر نضع معادلة من خلالها .. والمعادلة ببساطة زي ما شفناها من شوية بس بتكون بين أقواس تنصيص .. طيب الجزء الأول من السطر نلاحظ إننا استخدمنا Cells ودي بتكون متبوعة بقوسين ، وبين القوسين رقم الصف ثم فاصلة ثم رقم العمود ، وبما إن رقم الصف ثابت اللي هو رقم 4 ، فكتبناه زي ما هو .. اما رقم العمود فمتغير فوضعنا رقم العمود X ... جرب الكود وشوف النتيجة بنفسك أرجو أن أكون قد وفقت في توصيل المعلومة بأسلوب مبسط كان معكم أخوكم أبو البراء من تراك أوفيسنا (لف على الحلقات من الحلقة رقم 1 إلى الحلقة رقم 14 .. لو عايز تتعلم الـ VBA) ويا رب ميكونش فيه حد جاله دووووووووخة من كتر اللف .. والله أنا اللي دوخت أستودعكم الله .. دمتم في رعاية الله تقبلوا تحياتي .. دمتم بود
    1 point
  33. السلام عليكم جرب الكود التالي Sub kh_Sort_Delete() Dim Cel As Range Dim LR As Long, R As Long LR = Sheets("المدخلات").Range("a" & Rows.Count).End(xlUp).Row With Sheets("المدخلات").Range("A3:Y" & LR) .Sort .Columns(1), xlAscending For R = 1 To .Rows.Count If WorksheetFunction.CountIf(.Cells(1, "A").Resize(R), .Cells(R, "A")) > 1 Then If Cel Is Nothing Then Set Cel = .Cells(R, "A") Else Set Cel = Union(Cel, .Cells(R, "A")) End If Next End With If Not Cel Is Nothing Then Cel.EntireRow.Delete Set Cel = Nothing End Sub واشعرنا بانتيجة تحياتي
    1 point
×
×
  • اضف...

Important Information