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

عموماً قمت بتعديل الكود الأخير ليناسب طلبك Sub MissingNumbers_YK_C() Dim InputRange As Range, Text As String Dim X As Long Set InputRange = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row) For X = WorksheetFunction.Min(InputRange) To WorksheetFunction.Max(InputRange) If IsError(Application.Match(X, InputRange, 0)) Then Text = Text & X & vbCrLf End If Next X MsgBox Text, vbMsgBoxRtlReading End Sub يا ريت يكون الموضوع استوفى حقه

لأنها الرسالة غير عملية في رأيي الأفضل أن تكون النتائج في نطاق

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

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

أخي الفاضل هيثم شعبان بالنسبة لملفك قم بتسمية النطاق الذي به الرقم الوظيفي E15:E100 مثلاً حسب الأعداد عندك قم بتسميته IDRange روح لورقة العمل المسماة ايصال وفي الخلية K6 ضع المعادلة التالية =IF(OR($I$6<MIN(IDRange),$I$6>MAX(IDRange)),"",INDIRECT(ADDRESS(MATCH($I$6,IDRange,0)+14,6,4,,"2008"))) لما تحب تستخدم المعادلة في خلية أخرى لجلب بيان آخر فقط غير رقم 6 في المعادلة ودا بيمثل رقم العمود .. الاسم في العمود رقم 6 طيب القسم في العمود رقم كام ؟؟ في العمود رقم 3 يبقا غير المعادلة بحيث إن رقم 6 يستبدل برقم 3 إذا صادفك مشكلة في المعادلة قم بتغيير الفاصلة لفاصلة منقوطة ; شرح المعادلة على هذا الرابط (مع تغيير اسم النطاق المسمى فقط) من هنا

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

دكتور محمد صلاح الملف المرفق صراحة لا يطاق استغرق حوالي 4 دقائق لفتحه عندي والتعامل صعب داخل المصنف رغم أنه لا يحوي إلا ورقة عمل واحدة عموماً بعد ما طلع روحي في ملفك جرب الكود التالي ستظهر النتائج في العمود المجاور العمود L Sub MissingNumbers_YK_B() 'يقوم الكود باستخراج الأرقام الناقصة في تسلسل للأرقام ولا يشترط الترتيب '------------------------------------------------------------------- 'تعريف المتغيرات Dim InputRange As Range Dim X As Long, lRow As Long 'تعيين النطاق الذي سيحتوي على سلسلة الأرقام المراد استخراج الأرقام الناقصة منها Set InputRange = Range("M7:M" & Cells(Rows.Count, "M").End(xlUp).Row) 'مسح محتويات النطاق الذي سيتم استخراج النتائج به Range("L7:L1000").ClearContents 'حلقة تكرارية من أقل قيمة بالنطاق لأكبر قيمة بالنطاق For X = WorksheetFunction.Min(InputRange) To WorksheetFunction.Max(InputRange) 'استخدام دالة البحث فإذا كانت القيمة المراد البحث عنها غير موجودة يعطي خطأ 'وبناءً على الخطأ يتم تنفيذ السطر التالي If IsError(Application.Match(X, InputRange, 0)) Then '[L] الرقم 7 هو رقم صف البداية في العمود '[L7] يتم وضع الرقم الناقص في الخلية في الصف المحدد في الخلية Cells(lRow + 7, "L") = X 'زيادة المتغير بمقدار واحد للانتقال لصف جديد لإدراج الأرقام الناقصة lRow = lRow + 1 End If Next X End Sub طبعاً الكود سيستغرق دقائق لأن عدد الأرقام الناقصة في ملفك حوالي 16000 وشوية تقبل تحياتي

أخي الحبيب أبو سليمان بعد عدد 1225 مشاركة لك بالمنتدى ولا تعرف أين يوضع الكود ........؟؟!!!!! (لا تعليق) عشان لو علقت هعلق نفسي في حبل وأخلص منها !!!!!!!!!! حاول تتعلم وابدأ من الصفر مفيش مشكلة بس يا ريت متطولش عند نقطة الصفر يوجد في التوقيع الخاص بي رابط اليوتيوب فيه بعض الفيديوهات حاول تشوفها ويوجد بالمنتدى مئات الموضوعات التي تقدم لك المعلومة بسهولة ويسر تقبل تحياتي يا مجنني

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

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

أخي الحبيب ماجد بما أن البيانات لديك كثيرة فإليك هذا الحل السحري باستخدام المصفوفات Sub CopyDataUsingArrays() Dim A, I As Long, II As Long, N As Long, myDate With Sheets("Inv.History") myDate = .[C2].Value With .[A4].CurrentRegion.Offset(1) .ClearContents A = Sheets("Invoices").Cells(1).CurrentRegion.Value For I = 2 To UBound(A, 1) If A(I, 2) = myDate Then N = N + 1 For II = 1 To UBound(A, 2) A(N, II) = A(I, II) Next End If Next If N > 0 Then .Resize(N).Value = A End With End With End Sub جرب الكود وأعلمنا بالنتيجة ..جرب الكود على الملف الأصلي تقبل تحياتي Invoices V2.rar

أخي الحبيب أبو سليمان (رفقاً بنا ........ أين الالتزام بالتوجيهات) يرجى البحث أولاً عن طلبك بالمنتدى ثم إذا لم تجد اطرح موضوع جديد الغريب في الأمر أنني قدمت ثلاثة حلول متتالية لطلبك في موضوعك على هذا الرابط من هنا في المشاركة رقم 25 و 26 و 27 (إنت شوية كدا وهتجنني بطلبك لنفس الطلبات !!!!!!!!!!!!!!!!!!!!!!!)

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

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

أخي وحبيبي الباشمهندس طارق بارك الله فيك لك بصمة وعلامة في موضوعات كثيرة بالمنتدى إشارة لطلب الأخ هاوي الإكسيل فيما يخص طلبه بهذا الخصوص أقدم له دالة تتعامل مع الأرقام الكبيرة Function DecToBin(ByVal DecimalIn As Variant, Optional NumberOfBits As Variant) As String 'تقوم الدالة المعرفة بتحويل الأرقام بالنظام العشري إلى النظام الثنائي ' The DecimalIn argument is limited to 79228162514264337593543950245 ' (approximately 96-bits) - large numerical values must be entered ' as a String value to prevent conversion to scientific notation. Then ' optional NumberOfBits allows you to zero-fill the front of smaller ' values in order to return values up to a desired bit level. '=DEC2BIN(MOD(QUOTIENT(A1,256^3),256),8)&DEC2BIN(MOD(QUOTIENT(A1,256^2),256),8)&DEC2BIN(MOD(QUOTIENT(A1,256^1),256),8)&DEC2BIN(MOD(QUOTIENT(A1,256^0),256),8) '--------------------------------------------------------------------- DecToBin = "" DecimalIn = CDec(DecimalIn) Do While DecimalIn <> 0 DecToBin = Trim$(Str$(DecimalIn - 2 * Int(DecimalIn / 2))) & DecToBin DecimalIn = Int(DecimalIn / 2) Loop If Not IsMissing(NumberOfBits) Then If Len(DecToBin) > NumberOfBits Then DecToBin = "Error - Number too large for bit size" Else DecToBin = Right$(String$(NumberOfBits, "0") & DecToBin, NumberOfBits) End If End If End Function كما يوجد بالملف المرفق حل بالمعادلات وحل آخر عن طريق الفورم تقبل تحياتي Decimal To Binary.rar

أخي الحبيب لا أحبذ العمل في حدث ورقة العمل في حالة البيانات الكبيرة ..لأن في حالتك Worksheet_Selection Change مع كل تحديد للخلايا سيتم تنفيذ الكود وهو أمر مرهق أعتقد أنه من الأفضل عمل زر وربط الماكرو به تيسيراً عليك وإذا أردت تحديث البيانات فقط اضغط الزر أما بالنسبة لعدم استخدامي للفلترة المتقدمة فهو من باب التنوع في الحلول ولأن الفلترة تقوم بعمل نطاقات مسماة وهو ما أستحبه شخصياً أمر آخر يمكنك استخدام الاستدعاء للكود باستخدام Worksheet_Change أفضل بهذا الشكل Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.CountLarge > 1 Then Exit Sub If Not Intersect(Target, Range("C2")) Is Nothing Then Call FilterDataAccordingToDates End If End Sub جرب الكود بهذا الشكل وأعلمنا بالنتيجة

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

أعتقد أن الطلب لمرة واحدة ..الأخ السائل يطلب ترتيب البيانات بشكل عشوائي مرة واحدة ..بعد ما يتحقق المطلوب يحذف العمود الذي به الدالة وحتى لو لم يحذف العمود فلن يتأثر عمود البيانات إلا إذا أراد أن يقوم بالترتيب مرة أخرى تقبل تحياتي

أخي الحبيب رشراش علي لما تلاقي كنز متاخدش منه حبة ..اهبر هبرة كبيرة على أد ما تقدر (ليه تاخد معلقة من الطبق لما ممكن تاخد الطبق كله) لما تنشن لازم تنشن صح ... نشنت يا ياسر !! فما تطلبش طلب واحد اطلب حاجة كبيرة تستاهل أنا بناشد الأخ الحبيب والمتميز أسامة البراوي أن يفيض علينا مما أنعم الله عليه من علم في كيفية عمل الفورم من الألف للياء (عمل دورة للفورم ..نظراً لخبرته الواسعة في هذا المجال) تقبلوا تحياتي :fff:

ربنا يبارك فيك أخي وحبيبي علاء أخيراً لقيت حد يسند معايا ويوجه الأعضاء ربنا يجازيك خير تقبل تحياتي

وجزيت بمثله يا شيخ الشباب مشكور على الالتزام بالتوجيهات الحمد لله الذي بنعمته تتم الصالحات ..هذا من فضل ربي ، ولئن شكرتم لأزيدنكم

أخي الكريم يرجى تغيير اسم الظهور للغة العربية بالنسبة لسؤالك الأمر سيان يمكن أن تكون المعادلة بهذا الشكل =PROPER(TRIM(A1)) أو بهذا الشكل =TRIM(PROPER(A1)) كلاهما يؤدي نفس الغرض .. تقبل تحياتي وتوجيهاتي

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

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

جزيت خيراً أخي الحبيب أبو صلاح الحمد لله أن تم المطلوب على خير التزم بالتوجيهات من غير ما أنوه .. تقبل تحياتي