محي الدين ابو البشر

السلام عليكم اسناذ ياسر عذراً منك لكني يبدو أني مشاكس ماذا لو اردنا أن نطبع عدد صفحات محدد أي نختار من sheet1 مثلاً 19 صفحة ومن sheet 2 4 صفحات وهكذا بصراحة حاولت لكني اخفقت اسف على الإزعاج بارك الله بك ولك وجرزالك الله كل خير

السلام غليكم واسعد الله صباحك دائما مبدع أثابك الله خيرأً كثيراً

السلام عليكم استاذ ياسر بارك الله بك وانا بالانتظار على أحر من لجمر مواضيعك الرائعة دمتم

السلام عليكم بعد اذنك استاذ ياسر ماذا عن Redim preserve انت تغلبت علها بثلاثة أسطر Sheets("Sheet2").Rows("2:" & X).Insert myData = Evaluate("IF(ROW(2:" & X + Y & ")<=" & X & ",Sheet1!A2:A" & X & ",Sheet2!A2:A" & X + Y & ")") Sheets("Sheet2").Rows("2:" & X).Delete لكن فقط من أجل الإفادة أسأل

السلام عليكم فقط استفسار اذا كان لدينا رقمين فقط فالمفروض ان الاحتمالات احتمالين الآن عدد الخانات 4 أو متغير ماذا لوكانت الخانات يكمن تحديدها (متغيرة) أرجو الإفادة

السلام عليكم بارك الله بك وجزالك كل خير وأنالك ثواب كل ساعة أو دقيقة عن الستة أشهر حسنة في ميزان أعمالك

السلام علكيم استاذ ياسر بارك الله لك وجزاك كا خير على جهودك وبحثك اتعبتك معي سامحني

السلام عليكم بارك الله بك وبجهودك اسف أني اتعبك معي جزاك الله كل خير

??

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

السلام عليكم استاذ ياسر لا أدري حاولت مع redim presereve لكن ام تعمل معي لذلك حاولت بطريقة أخرى فأدت إلى خطأ أرجو النظر في هذا الكود وتحديد الخطأ الذي ارتكبته بارك الله بك Sub UniqueByDictionary() 'يقوم الكود باستخراج القيم الفريدة أي الغير مكررة باستخدام الكائن قاموس '---------------------------------------------------------------------- 'المتغير الأول لتخزين قيم النطاق والمتغير الثاني لتخزين مفاتيح القاموس 'الثالث متغير للكائن القاموس والرابع متغير يستخدم في عمل حلقة تكرارية Dim myData As Variant, Temp As Variant Dim Obj As Object, I, x As Long Dim lr1, lr2 As Long Sheet1.Activate lr1 = Cells(Rows.Count, 1).End(xlUp).Row ReDim myData(1 To lr1) As Variant Sheet2.Activate MsgBox UBound(myData) lr2 = Cells(Rows.Count, 1).End(xlUp).Row 'ليساوي الكائن المسمى القاموس والذي يعتبر أداة قوية للتعامل مع القيم الفريدة [Obj] تعيين المتغير Set Obj = CreateObject("Scripting.Dictionary") 'ليساوي قيم النطاق في العمود الأول [myData] تعيين المتغير myData = Sheet1.Range("A2:A" & lr1) ReDim myData(1 To lr1 + lr2) As Variant MsgBox UBound(myData) For x = lr1 + 1 To UBound(myData) myData(x) = Sheet2.Range("A" & x) Next x 'حلقة تكرارية تبدأ من أول عنصر في مصفوفة القيم إلى آخر عنصر في المصفوفة For I = 1 To UBound(myData) 'هذا السطر هو أهم سطر في الكود حيث يتم تمرير القيمة للقاموس 'فيقوم القاموس بتخزينها إذا كانت القيمة تصادفه لأول مرة 'أما إذا كانت القيمة مكررة فلا يقوم بتخزينها مرة أخرى Obj(myData(I, 1) & "") = "" Next I 'ليساوي مفاتيح القاموس والتي تمثل القيم الغير مكررة [Temp] تعيين المتغير Temp = Obj.Keys 'حيث يتم تحديد عدد الصفوف [E1] وضع عناصر القاموس الغير مكررة في الخلية 'والتي تقوم بعد عناصر القاموس التي تم تخزينها [Count] من خلال كلمة 'عبارة عن مصفوفة بالقيم تكون على شكل أفقي لذا نستخدم [Temp] المتغير 'لتحويل القيم من الشكل الأفقي إلى الشكل الرأسي ليناسب وضع النتائج في عمود [Transpose] كلمة Sheet3.Range("C1").Resize(Obj.Count, 1) = Application.Transpose(Temp) End Sub

السلام عليم بارك الله بك استاذ ياسر سأعمل على الموضوع وساعود إليك إذا مش ولا بد

السلام عليكم في محاولتي لفهم الموضوع وتطبيقه عملياً حصل معي تداخل مع دروس المصفوفات: في السطر: myData = sheet.Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value تم وضع القيم في القيم في المصفوفة myData ما احاول عمله هو إضافة قائمة أخرى من sheet آخر أو اكثر إلى المصفوفة myData ليتم المطلوب على اكثر من قائمة في اكثر من sheet أو كيف نجعل Dictionary يتعامل مع عدة مصفوفات كأنها مصفوفة واحدة امر آخر: في نفس السطر .value. لم أعرف اهميتها حيث وضعت احرف بعد تنفيذ الماكرو تم الأمر وضعت معادلة في نفس العمود وبعد تنفيذ الماكرو نقل المعادلة كـ قيمة وليس كمعادلة أرجو الإفادة ودمتم ذخراً

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

السلام عليكم وجمعة مباركة يإذن الله استاذ ياسر بارك لله بك وجزاك كل خير تستحقه شرح رائع

الحال من بعضه استاذ YasserKhalil على كل حال وعكة صحية وانشغال وكهرباء مقطوعة ونت سيئة ... خليها لله

السلام عليكم بعد إذن الاستاذ سليم تعديل بسيط حسب ما يحب أبو البراء Sort_by_text_len advanced Macro2.rar

حسنا ولكن هل يمكن أن تمهلني إلى الغد لاني بصراحة تعبت وانا على الكمبيوتر من الساعة السابعة صباحا

اذا برأيك لن يؤدي إلى السرعة في التنفيذ؟

حسناً بدل CASE اعتقد لو اسندنا الجدول إلى مصفوفة قد يكون تنفيذها اسرع ام ما هو رايك؟

كلامك صحيح استاذ حسين لكن مشكلتي ان هذه الدالة التي اتمناها سوف استخدمها في معادلة طويلة نوعا ما لاختصار طول المعادلة بالمناسبة هذا function جربت فيه ما اريد لكن المشكلة أنه يسبب بطء شديد عند تطبيقه (حوالي 500 -600 قيمة) كنت اتمنى أن اجد ما هو اسرع منه Function percent(TargetCell As Range) As Double Application.Volatile Dim C Dim n As Double n = TargetCell.Value Select Case n Case Is > Sheet5.Cells(10, 15).Value: C = Sheet5.Cells(10, 13).Value Case Is > Sheet5.Cells(9, 15).Value: C = Sheet5.Cells(9, 13).Value Case Is > Sheet5.Cells(8, 15).Value: C = Sheet5.Cells(8, 13).Value Case Is > Sheet5.Cells(7, 15).Value: C = Sheet5.Cells(7, 13).Value Case Is > Sheet5.Cells(6, 15).Value: C = Sheet5.Cells(6, 13).Value Case Is > Sheet5.Cells(5, 15).Value: C = Sheet5.Cells(5, 13).Value Case Is > Sheet5.Cells(4, 15).Value: C = Sheet5.Cells(4, 13).Value Case Is > Sheet5.Cells(3, 15).Value: C = Sheet5.Cells(3, 13).Value Case Is > Sheet5.Cells(2, 15).Value: C = Sheet5.Cells(2, 13).Value Case Is > Sheet5.Cells(1, 15).Value: C = Sheet5.Cells(1, 13).Value End Select percent = C End Function هل يمكن مساعدتي جزاك الله كل خير

تماما استاذي العزيز افترض أن لجدول موجود في SHEET ما واقوم بادخال القيم او تعديلها

السلام عليكم نعم استاذ حسن دالة تعطي لكنسبة بناءا علي القيمة التي تدخلها وذلك وفقا لجدول ثابت لهذه النسب المشكل أن المجال من الممكن أن يتغير مثلا المجال 90000 _ 100000 ممكن يصبح 60000 - 85000 هذا من جهة ومن جهة أخرى ممكن أن تزيد المجالات حتى تصبح النسبة 40% أو 50% أرجو أن أكون قد وضحت الفكرة وان يكون هناك امكانية لذلك كنت أفكر بوضع الجدول وجعله ديناميكيا في مصفوفة ضمن الـ UDF المطلوب شكرا لك على ردك وبارك الله بك وسر خاطرك

السلام عليكم أخي العزيز من قائمةINSERT ثم Equationπبعدها يمكن اختياء ما يناسبك

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