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

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

الأخ أبو فاطمة أعتقد أنه تمت الإجابة على موضوعك ..يرجى أن تحدد أفضل إجابة ليظهر الموضوع مجاب ومنتهي تقبلوا تحياتي (أخي علاء رسلان وأخي سليم)

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

الأخ عبد العزيز البسكري جزيت خيراً على مرورك العطر نداء إلى أخي الحبيب سليم يرجى تطبيق الكود الخاص بك على الملف الأصلي في النطاق A5:A وحتى آخر صف ..شوف النتائج ...............الكود بيحصل إنه بيهنج ولابد من الضغط على Ctrl + End لينتهي عمل الكود !! ويعطي نتائج أكثرمن اللازم

إخواني الكرام تم رفع الملف مرة أخرى لمن قام بالتحميل لأنه تمت إضافة دالة معرفة تؤدي الغرض إن شاء الله تقبلوا تحياتي

أخي الحبيب سليم بارك الله فيك جزاك الله كل خير الأخ الكريم نايف والأخوة الكرام تم إعادة رفع الملف مرة أخرى في المشاركة الأولى بعد التعديل عليها نظراً لأنني أضفت حل بمعادلة صفيف ليناسب طلب الأخ نايف من حيث أن الأرقام غير مرتبة ..وبدون أعمدة مساعدة يا مستر سليم الأخ الحبيب ياسر فتحي / الأخ الغالي الزباري / الأخ الكريم صلاح الصغير مشكور على مرروكم العطر بالموضوع ، بارك الله فيكم تقبلوا تحياتي

الأخ الكريم جابر يرجى تغيير اسم الظهور للغة الزهور اللغة العربية الأخ الحبيب والمعلم الكبير محمد صالح ..بارك الله لنا فيك وجزاك الله خيراً إثراءً للموضوع إليك الملف التالي بدون أعمدة مساعدة يرجى تحديد أفضل إجابة ليظهر الموضوع مجاب ومنتهي تقبلوا تحياتي Number Analysis By Formulas & By UDF Function YasserKhalil.rar

أخي الفاضل يرجى مراجعة الرابط التالي لمعرفة كيفية التعامل مع المنتدى من هنا

بارك الله فيك أخي المتأمل .. وجزيت خيراً على تلبية طلبي تقبل تحياتي

أخي الكريم ابو صلاح رقم 4 يمثل رقم العمود الذي يتم جلب رقم آخر صف منه وهو العمود الرابع أي العمود D أما الرقم 3 فهو بديل للجملة Xlup أي أنه يمكن استخدام الكلمة دي بدلاً من رقم 3 والصف كله لتحديد آخر خلية بها بيانات في العمود الرابع

الأخ الفاضل عبد الله شيخون إليك الملف التالي عله يفي بالغرض Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.CountLarge > 1 Then Exit Sub Application.EnableEvents = False If Target.Row > 5 Then If Format(Cells(2, Target.Column), "ddd") = "الجمعة" _ Or Format(Cells(2, Target.Column), "ddd") = "السبت" Then Target.ClearContents: Target.Select End If End If Application.EnableEvents = True End Sub تقبل تحياتي كشف الغياب.rar

اطلعت على الملف واللغة العربية بداخله ظاهرة بشكل طبيعي إذاً المشكلة في الويندوز لديك في غالب الأمر

كلمة السر لمحرر الأكواد؟

بسبب إن الأوفيس 2003 ..جرب 2007 جرب المعادلة بهذا الشكل =IF(ISERR(INDEX($E$1:$E$6,MATCH($B$11,$E$1:$E$6,0)+1)),$E$1,INDEX($E$1:$E$6,MATCH($B$11,$E$1:$E$6,0)+1))

الحمد لله الذي بنعمته تتم الصالحات مشكور على دعائك الطيب المبارك دعوة مرة أخرى أخي الكريم لتغيير اسم الظهور للغة العربية راجع الرابط التالي رابط التوجيهات

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

جزيت خيراً أخي الغالي أيمن إبراهيم على الاستجابة لطلبي والله اسمك بالعربي منور أكتر

الأخ الكريم أبو فاطمة يرجى تحديد أفضل إجابة ليظهر الموضوع مجاب ومنتهي بارك الله فيك أخي الغالي محمد الريفي وعوداً حميداً تقبلوا تحياتي

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

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

الأخوة الكرام مشكور على مرروكم العطر الأخ الغالي أبو يوسف جزيت خيراً على مرورك العطر ومشكور على كلماتك الرقراقة العذبة التي تسعد القلوب ..لا حرمنا الله منك الأخ الحبيب سليم دائماً ما تتحفنا بهداياك القيمة الأخ الفاضل نايف لما لا تقوم بترتيب الأرقام ثم تنفيذ الكود لتحصل على المطلوب

الأخ الكريم يرجى تغيير اسم الظهور للغة العربية استبدل السطر التالي Rng.Rows(row).Copy Wks.Rows(NextRow) وضع مكانه هذين السطرين Rng.Rows(row).Copy Wks.Rows(NextRow).PasteSpecial xlPasteValues لتحصل على القيم فقط لا تنسى أن تحدد أفضل إجابة ليظهر الموضوع مجاب ومنتهي

والاجمل مرروك العطر أخي الحبيب أسامة تقبل تحياتي

أنا لي وجهة نظر وعمرها إن شاء الله ما بتخيب ... الأخوة في المنتدى سيستفيدون منك بشكل كبير جداً وأنا أولهم بس يا ريت متنسناش يا كبير .. تقبل ودي وحبي وتحياتي :fff:

إخواني الكرام في المنتدى الغالي أقدم لكم اليوم موضوع ليس بالجديد ولكنه جد مفيد (جد .. يعني جداً أوك يا جدو) ..أقصد مفيد جداً الموضوع يتمحور ويتمركز حول معرفة الأرقام المفقودة أو الأرقام الناقصة في سلسلة أرقام .. إليكم الكود الأول المؤدي للغرض (هنا يشترط ترتيب الأرقام) ، مع شرح تفصيلي لأسطر الكود لتتمكن من التعديل عليه Sub MissingNumber_NumbersSorted() 'يقوم الكود بإظهار الأرقام الناقصة في تسلسل معين للأرقام ويشترط ترتيب الأرقام '------------------------------------------------------------------------- Dim SH As Worksheet Dim LR As Long Dim Text As String Dim I As Long, X As Long, XX As Long '[Sheet1] تخصيص المتغير ليساوي ورقة العمل المسماة Set SH = Sheets("Sheet1") 'تحديد آخر صف به بيانات في العمود الأول LR = SH.Cells(SH.Rows.Count, 1).End(xlUp).Row 'حلقة تكرارية بداية من الصف الخامس وحتى آخر صف به بيانات في العمود الأول For I = 5 To LR 'يساوي الفرق بين قيمة الخلية التالية وقيمة الخلية الحالية في الصف المحدد [X] المتغير X = Val(SH.Range("A" & I + 1)) - Val(SH.Range("A" & I)) '[X] استخدام الجملة الشرطية لناتج المتغير Select Case X 'إذا كان الفرق بين قيمة الخليتين أكبر من 1 يتم تنفيذ الحلقة التكرارية ما بين السطرين Case Is > 1 'حلقة تكرارية لتخزين الأرقام الناقصة For XX = 2 To X 'يساوي المتغير نفسه مع قيمة الخلية الحالية مضاف إليها قيمة المتغير في الحلقة التكرارية ناقص واحد ثم سطر جديد[Text]المتغير المسمى 'مثال لفهم هذا السطر '------------------- 'توجد القيمة 50012 [A15] توجد القيمة 50009 وفي الخلية [A14] في الخلية 'بما أن الفرق بين الخليتين يساوي 3 إذاً سيتم تنفيذ الحلقة التكرارية 'بداية الحلقة التكرارية 2 حيث أن رقم 2 هو أول رقم أكبر من واحد ، وفي مثالنا نهاية الحلقة التكرارية تساوي 3 'المتغير المفترض تخزين الأرقام الناقصة فيه عبارة عن سلسلة نصية فيتم إضافة النصوص التي سبق استخراجها ثم إضافة النصوص الجديدة 'الأرقام الناقصة تساوي قيمة الخلية الحالية 50009 في المثال مضافاً إليها قيمة الحلقة التكرارية والتي هنا تساوي 2 في بداية الحلقة التكرارية ليصبح الناتج 50011 ثم ناقص واحد لتحصل على أول رقم ناقص ألا وهو 5010 'يساوي 3 لتحصل في النهاية على الرقم التالي الناقص ألا وهو 5011[XX]مع الانتقال في الحلقة التكرارية يصبح المتغير Text = Text & Val(SH.Range("A" & I)) + XX - 1 & vbCrLf Next End Select Next 'رسالة لإظهار الأرقام الناقصة MsgBox Text, vbMsgBoxRtlReading End Sub وإليكم الكود الثاني وهو أقوى في أنه لا يشترط ترتيب الأرقام Sub MissingNumbers_YK_A() 'يقوم الكود باستخراج الأرقام الناقصة من سلسلة من الأرقام ولا يشترط ترتيب الأرقام '---------------------------------------------------------------------------- Dim InputRange As Range, OutputRange As Range, ValueFound As Range Dim LowerVal As Single, UpperVal As Single, Count_I As Single, Count_J As Single Dim NumRows As Long, NumColumns As Long Dim Horizontal As Boolean On Error GoTo ErrorHandler 'النطاق الذي يحتوي سلسلة الأرقام المراد استخراج الأرقام الناقصة منها Set InputRange = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row) LowerVal = WorksheetFunction.Min(InputRange) UpperVal = WorksheetFunction.Max(InputRange) Horizontal = False 'بداية النطاق الذي سيتم استخراج النتائج به Set OutputRange = Range("E2") NumRows = OutputRange.Rows.Count NumColumns = OutputRange.Columns.Count Application.ScreenUpdating = False If NumRows < NumColumns Then Horizontal = True NumRows = 1 Else NumColumns = 1 End If Count_J = 1 For Count_I = LowerVal To UpperVal Set ValueFound = InputRange.Find(Count_I, LookIn:=xlValues, LookAt:=xlWhole) If ValueFound Is Nothing Then If Horizontal Then OutputRange.Cells(NumRows, Count_J).Value = Count_I Count_J = Count_J + 1 Else OutputRange.Cells(Count_J, NumColumns).Value = Count_I Count_J = Count_J + 1 End If End If Next Count_I Application.ScreenUpdating = True Exit Sub ErrorHandler: End Sub كما تمت إضافة حل بمعادلات الصفيف لتؤدي نفس الغرض وإليكم أيضاً كود رائع للأخ الحبيب سليم حاصبيا مع شرح للأسطر ولا يشترط الترتيب للأرقام أيضاً Sub MissingNumbers_SALIM() 'يقوم الكود باستخراج الأرقام الناقصة في سلسلة أرقام ولا يشترط الترتيب '------------------------------------------------------------------ 'تعريف المتغيرات Dim Dico, D Dim C As Range, Rng As Range Dim B As Long, I As Long Dim MinVal As Double, MaxVal As Double 'النطاق المراد استخراج الأرقام الناقصة منه Set Rng = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row) 'سطر لايجاد أقل قيمة رقمية في النطاق MinVal = Application.WorksheetFunction.Min(Rng) 'سطر لايجاد أكبر قيمة رقمية في النطاق MaxVal = Application.WorksheetFunction.Max(Rng) 'مسح محتويات النطاق الذي سيتم استخراج النتائج به Range("G2", Range("G2").End(xlDown)).ClearContents 'إنشاء متغير من النوع كائن لتخزين الأرقام الناقصة به Set Dico = CreateObject("Scripting.Dictionary") 'حلقة تكرارية لكل الأرقام المسلسلة For I = 1 To (MaxVal - MinVal + 1) 'تعتمد هذه الأسطر على إضافة الرقم الناقص إلى الكائن المخصص لذلك If Application.WorksheetFunction.CountIf(Rng, MinVal + I - 1) = Then If Not Dico.Exists(MinVal + I - 1) Then Dico.Add (MinVal + I - 1), (MinVal + I - 1) End If Next I 'رقم صف البداية للنتائج في العمود السابع B = 2 'حلقة تكرارية لوضع القيم التي تم تخزينها في النطاق المحدد For Each D In Dico.items Range("G" & B) = D B = B + 1 Next D End Sub وعشان عيون أحبابي إليكم الكود الرابع وهو أفضل الأكواد من حيث أنه لا يشترط ترتيب الأرقام وأسطر الكود سهلة الفهم وسهلة التعامل معها Sub MissingNumbers_YK_B() 'يقوم الكود باستخراج الأرقام الناقصة في تسلسل للأرقام ولا يشترط الترتيب '------------------------------------------------------------------- 'تعريف المتغيرات Dim InputRange As Range Dim X As Long, lRow As Long 'تعيين النطاق الذي سيحتوي على سلسلة الأرقام المراد استخراج الأرقام الناقصة منها Set InputRange = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row) 'مسح محتويات النطاق الذي سيتم استخراج النتائج به Range("I2:I1000").ClearContents 'حلقة تكرارية من أقل قيمة بالنطاق لأكبر قيمة بالنطاق For X = WorksheetFunction.Min(InputRange) To WorksheetFunction.Max(InputRange) 'استخدام دالة البحث فإذا كانت القيمة المراد البحث عنها غير موجودة يعطي خطأ 'وبناءً على الخطأ يتم تنفيذ السطر التالي If IsError(Application.Match(X, InputRange, )) Then '[I] الرقم 2 هو رقم صف البداية في العمود '[I] يتم وضع الرقم الناقص في الخلية في الصف المحدد في العمود Cells(lRow + 2, "I") = X 'زيادة المتغير بمقدار واحد للانتقال لصف جديد لإدراج الأرقام الناقصة lRow = lRow + 1 End If Next X End Sub أترككم مع الملف المرفق ...للاستفادة بشكل عملي بالكود كان معكم أخوكم ياسر خليل أبو البراء YK (الموضوع مهدى للأخ الحبيب والأستاذ الكبير أسامة البراوي OB ومهدى للأخ الفاضل نايف - م) حمل الملف من هنا تقبلوا تحياتي