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

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

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

تفضل أخي الكريم Sub AutoFill() With Range("B6", Range("B" & Rows.Count).End(xlUp)) .SpecialCells(2).Offset(, 1).Formula = [C6].Formula .SpecialCells(2).Offset(, 2).Formula = [C6].Formula End With End Sub إذا أعجبك الحل لا تنسى أن تحدد المشاركة كأفضل إجابة ليظهر الموضوع مجاب

أخي الكريم إليك الملف التالي عله يفي بالغرض Sub AutoFill() With Range("B6", Range("B" & Rows.Count).End(xlUp)) .SpecialCells(2).Offset(, 1).Formula = [C6].Formula End With End Sub تقبل تحياتي AutoFill YasserKhalil.rar

هل تقصد كميات الأصنف بشكل عام أم لهذا العميل الذي تمت التصفية على أساسه؟

مشكور على مرورك العطر يا مختار يا غالي يا مسهرني الليالي تقبل ودي واحتلالي ..قصدي احترامي

وهذا حل آخر بالأكواد Sub RandBewteenTwoNumbersNoDuplicates() '[A1:A100] يقوم الكود بتوليد أرقام عشوائية ما بين الرقم واحد ومائة في النطاق '--------------------------------------------------------------------------- Dim B(100), C, R 'حلقة تكرارية تنتهي بمجرد الوصول لرقم الصف 100 في العمود الأول Do 'دالة توليد أرقام عشوائية ما بين 1 و 100 C = Application.RandBetween(1, 100) 'مصفوفة بها 100 عنصر [B] يمثل المتغير '[B] داخل المصفوفة [C] هنا يتم اختبار أو فحص العنصر 'إذا لم يكن العنصر داخل المصفوفة If Not B(C) Then 'هذا السطر يمثل رقم الصف R = R + 1 '[C] الخلية في الصف رقم كذا في العمود الأول تساوي العنصر Cells(R, "A") = C 'للعنصر الذي تم وضعه ضمن القيم ليتم استبعاده في حالة التكرار [True] تعيين القيمة B(C) = True End If Loop Until R = 100 End Sub عشان متقولوش إني حارمكم من حاجة تقبلوا تحياتي

حل آخر ضع المعادلة التالية في الخلية A2 =LARGE(ROW($1:$100)*NOT(COUNTIF($A$1:A1,ROW($1:$100))),RANDBETWEEN(1,101-ROW(A1))) واضغط Ctrl + Shift + Enter واسحب المعادلة لحد الخلية A101 بس خلاص تقبل تحياتي

بارك الله فيكم إخواني الكرام إثراءاً للموضوع في الخلية A1 ضع المعادلة التالية =RAND() اسحب المعادلة حتى الخلية A100 كدا العمود A بنسميه عمود مساعد في الخلية B1 اكتب المعادلة التالية واسحبها لحد B100 =RANK(A1,$A$1:$A$100) بس خلاص .. تقبلوا تحياتي

أخي الكريم أبو يوسف جرب تغير رقم 9 إلى 109 في معادلة Subtotal إذا لم يكن هذا يؤدي الغرض فقم بإرفاق بعض المخرجات لمعرفة طلبك بشكل أدق

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

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

أستاذي ومعلمي وأخي في الله الباشمهندس طارق اسمح لي أن أتناقش معك في الكود لأعرف أكثر وأتعلم أكثر منك ومن خبراتك اللامحدودة في هذا السطر [A6:D666].Delete Shift:=xlUp لم يتم حذف صفوف النطاق الذي سيتم إدراج النتائج فيه .. أليس من الممكن أن نستخدم السطر بهذا الشكل [A6:D666].ClearContents في سطر آخر يتم جلب البيانات ابتداءً من الصف الثالث ثم في الكود تقوم بحذف الجزء الخاص بالصف الذي تم جلبه Union(.Range("A3:A" & nR), .Range("C3:C" & nR), .Range("G3:G" & nR)).Copy [A6] [A6:D6].Delete Shift:=xlUp أليس من الممكن الاستغناء عن سطر حذف الصف السادس في ورقة النتائج ، أقصد سطر الكود المدرج أعلى كلامي وتعديل السطر السابق ليكون بهذا الشكل Union(.Range("A4:A" & nR), .Range("C4:C" & nR), .Range("G4:G" & nR)).Copy [A6] أمر آخر لم تم استخدام متغير LR في حين أنه يمكن عمل فلترة للبيانات باستخدام الصف الأول فقط في البيانات دون اللجوء إلى معرفة الصف الأخير .. بهذا يمكن الاستغناء عن المتغير LR أمر آخر الجملة الأخيرة في الكود لم لم تضمنها ما بين الجملة With و End With ليصبح الكود النهائي بهذا الشكل : Private Sub Worksheet_Change(ByVal Target As Range) Dim nR As Long If Intersect(Target, [C3]) Is Nothing Then Exit Sub slct = [C3] [A6:D666].ClearContents With Sheets("Sheet1") .Range("A3:G3").AutoFilter Field:=2, Criteria1:=slct nR = .[A9999].End(xlUp).Row Union(.Range("A4:A" & nR), .Range("C4:C" & nR), .Range("G4:G" & nR)).Copy [A6] .AutoFilterMode = False End With End Sub عذراً معلمي إن كنت أثقلت عليك .. فقط نريد أن نتعلم منك ومن خبراتك الرائعة تقبل ودي وحبي وتحياتي واحترامي

الأخ الفاضل الصاعق أهلا بيك في المنتدى ونورت بين إخوانك يرجى طرح طلبك في موضوع مستقل مع إرفاق ملف يرجى الإطلاع على رابط التوجيهات لمعرفة التوجيهات والقواعد في المنتدى وللإلمام بكيفية التعامل مع المنتدى http://www.officena.net/ib/index.php?showtopic=60147 ويا ريت متطنش التوجيهات دا مش روتين دا شيء شبه الزامي حتى تجد المساعدة من الأخوة الأفاضل بالمنتدى وبصراحة جيت في وقتك .. الناموس مبهدلني .. وريني شغلك مع الناموس تقبل تحياتي

الأخ الكريم إيهاب سعيد يرجى طرح طلبك في موضوع مستقل مع إرفاق ملف

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

بس لو حل المشكلة ابقا قولي .. إنت شغال على نسخة أوفيس كام ؟ لو تشتغل على نسخة أوفيس 2013 ..صراحة بندم إني لسه بتعامل معاه من فترة قريبة نسخة 2013 حكاية ...

لمعرفة كيفية التعامل مع المنتدى أخي الفاضل عمرو يرجى زيارة الرابط التالي http://www.officena.net/ib/index.php?showtopic=60147

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

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

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

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

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

أخي الفاضل نور أنور تفضل الملف المرفق عله يفي بالغرض Sub TarhilRaseb() Dim I As Long, X As Long Dim WS As Worksheet, SH As Worksheet Dim RngA As Long, RngB As Long Dim RngColA As Long, RngColB As Long Set WS = Sheets("علمى"): Set SH = Sheets("Raseb") RngA = SH.Range("D2").Value: RngB = SH.Range("E2").Value RngColA = SH.Range("D3").Value: RngColB = SH.Range("E3").Value X = 6 Application.ScreenUpdating = False SH.Range("A6:F1000").ClearContents With WS For I = 12 To .Cells(Rows.Count, 1).End(3).Row If .Cells(I, RngColA) < RngA Or .Cells(I, RngColB) < RngB Then SH.Cells(X, 1).Value = SH.Cells(X, 1).Row - 5 SH.Cells(X, 2).Value = WS.Cells(I, 2).Value SH.Cells(X, 3).Value = WS.Cells(I, 3).Value SH.Cells(X, 4).Value = WS.Cells(I, 12).Value SH.Cells(X, 5).Value = WS.Cells(I, RngColA).Value SH.Cells(X, 6).Value = WS.Cells(I, RngColB).Value X = X + 1 End If Next I End With Application.ScreenUpdating = True End Sub تقبل تحياتي Raseb All Subjects.rar

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