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

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

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

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

أخي الكريم محي الدين قم بإنشاء نطاق مسمى باسم List1 وضع المعادلة التالية فيه =OFFSET(Sheet1!$A$1,0,0,COUNTA(Sheet1!$A:$A)) وقم بإنشاء نطاق مسمى ثاني باسم List2 وضع المعادلة التالية فيه =OFFSET(Sheet2!$A$1,0,0,COUNTA(Sheet2!$A:$A)) وفي ورقة العمل الثالثة ستترك الخلية A1 وتبدأ المعادلة من الخلية A2 لتصبح بهذا الشكل (طبقاً لمثالك) =IFERROR(IFERROR(INDEX(List1,MATCH(0,IF(ISBLANK(List1),1,COUNTIF($A$1:A1,List1)),0)),INDEX(List2,MATCH(0,IF(ISBLANK(List2),1,COUNTIF($A$1:A1,List2)),0))),"") وهذه معادلة صفيف أي يجب الضغط على Ctrl + Shift + Enter ...

أخي الحبيب أحمد مدخلات صحيحة + كود منضبط حسب ورقة العمل وهيكلتها = نتائج صحيحة إن شاء الله

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

كم اشتقنا إليك أستاذنا الكبير جمال عبد السميع ؟! واشتقنا لرؤية مشاركاتك

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

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

أخي العزيز سليم الكود يحتوي على حلقات تكرارية لكل ورقة عمل على حدا .. السؤال : ماذا لو كان هناك على سبيل المثال 10 أوراق عمل ، وفي كل ورقة عمل لنقل 10000 صف من البيانات ..ترى كم سيستغرق الكود من الوقت لكي يقوم بعملية التنفيذ ؟ يمكن من الأخوة إنشاء مصنف به 6 أوراق عمل (5 أوراق ستكون فيها الأسماء في العمود الأول ويمتد لـ 10000 صف) وفي الورقة السادسة لإظهار النتائج بالنسبة للكود الذي قدمته سيكون من اليسير التعديل عليه .. فقط في سطرين For Each WS In ThisWorkbook.Worksheets(Array("Sheet1", "Sheet2")) والسطر الآخر تغيير اسم ورقة العمل المراد إظهار النتائج بها With Sheets("Sheet3") أما بالنسبة للكود الخاص بك فسيكون على من يريد التعديل إضافة حلقة تكرارية لكل ورقة عمل على حدا كما فعلت بالكود ناهيك عن أن الحلقات التكرارية مميتة مع كثرة البيانات أرجو أن يتسع صدرك لملاحظاتي

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

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

بارك الله فيكم إخواني وأحبابي في الله ولكن ما يقلقني أنني لم أتعود على تغيبه بهذا الشكل .. فهو دائم الاتصال بالمنتدى ، وإن لم يكن هناك كمبيوتر متاح فيقوم بالدخول للمنتدى عن طريق الموبايل .. فما باله غاب عنا ؟ لعل غيابه خير إن شاء الله

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

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

طيب إنت فين عشان نيجي ننفعك ونشتري منك كارت بـ 10 أو تحولنا بـ 3 رصيد .. وفقك الله أخي الحبيب الفلاحجي لما يحبه ويرضاه .. تقبل وافر تقديري واحترامي

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

أخي الحبيب محي الدين mohadin ... إليك الكود التالي عله يفي بالغرض Sub UniqueListFromMultipleSheets() Dim X, Y(), I&, J&, K&, WS As Worksheet ReDim Y(1 To Rows.Count, 1 To 1) With CreateObject("Scripting.Dictionary") .CompareMode = 1 For Each WS In ThisWorkbook.Worksheets(Array("Sheet1", "Sheet2")) X = WS.Range("A1:A" & WS.Cells(Rows.Count, 1).End(xlUp).Row).Value For I = 1 To UBound(X) If Len(X(I, 1)) Then If Not .Exists(X(I, 1)) Then J = J + 1 .Item(X(I, 1)) = J Y(J, 1) = X(I, 1) End If End If Next I Next WS End With With Sheets("Sheet3") .UsedRange.ClearContents .Range("A1").Resize(J, 1).Value = Y() End With End Sub تقبل تحياتي

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

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

أخي الكريم حراثي لابد أن تتعلم الأساسيات .. قم بالإطلاع على الموضوع التالي لتعرف كيفية التعامل مع محرر الأكواد بداية الطريق لإنقاذ الغريق بالنسبة للكود لن يقوم بالطباعة إنما معاينة فقط .. إذا أردت الطباعة عليك استبدال كلمة PrintPreview الموجودة في الكود بكلمة PrintOut

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

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

أخي الكريم جرب الكود التالي Sub PrintAll() Dim iStart As Integer, iEnd As Integer, I As Integer iStart = Feuil1.Range("J7").Value iEnd = Feuil1.Range("L7").Value For I = iStart To iEnd Feuil1.Range("I3").Value = I Feuil1.PrintPreview Next I End Sub

حاول تنصب الأوفيس مرة أخرى ..إذا لم تحل المشكلة قم بتنصيب نسخة أخرى تقبل تحياتي