نجوم المشاركات

استعمل هذا الكود Sub MyNmbr() Dim x As Integer, i As Integer x = 1 For i = 2 To Range("a1").Value * 3 Step 3 Cells(i, 3) = x x = x + 1 Next End Sub

ربما كان هذا المطلوب test2 salim.rar

ما شاء الله تبارك الله كفيتم ووفيتم كتب الله لكم الأجر وغفر لكم الذنب وأعانكم لكل خير عظيم الشكر وجزيل الامتنان لكم ..

السلام عليكم ورحمة الله وبركاته اكتب هذه المعادلة فى الخلية H3 =IF(OR($D3:$G3="ح");"ح";IF(OR($D3:$G3="غ");"غ";SUM($D3:$G3))) ثم اضغط على CRTL + ALT + SHIFT ثم اسحب نزولا

أخي الكريم سيد يرجى وضع عناوين مناسبة ومعبرة عن الطلب ..بارك الله فيك قم بالتالي : انسخ الكود لموديول جديد والصقه في الموديول .. في ورقة العمل المسماة "قوائم" وفي الخلية D1 ضع الصف المطلوب جلب القوائم له وليكن الرقم 1 للصف الأول في نفس ورقة العمل وفي الخلية المجاورة في الخلية E1 ضع الفصل المطلوب جلب القوائم له وليكن 1 أيضاً أي 1 / 1 ... ثم ارسم زر أمر واعمل كليك يمين عليه ثم Assign Macro واختر اسم الماكرو Test ليكون مرتبط بالتنفيذ .. انقر على زر الأمر لتنفيذ الكود ..وياريت تراجع النتائج بشكل جيد الكود من هنا تقبل تحياتي

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

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

شوف الرابط التالي لتعرف كيفية التحميل .. من هنا

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

يمكنك تجربة هذ الملف المصنف salim.rar

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

لتفعيل النسخ الإحتياطي التلقائي ، قم بما يلي: أولاً : إعدادت إختيار قواعد البيانات لعمل النسخ الإحتياطى التلقائي لها 1) انقر على الزر "إعداد النسخ الإحتياطي التقائي". أدخل المسار الكامل لقواعد البيانات التي ترغب في النسخ الاحتياطي لها.بإستخدام الزر "استعراض لإختيار قواعد البيانات" 2)انقر على الزر "إضافة قاعدة بيانات إلي القائمة" لإضافة قاعدة بيانات جديدة. 3) انقر مرتين على أي قاعدة بيانات في القائمة للتعديل أو الحذف. ــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــ ثانياً : إعدادات مسار تخزين النسخ الإحتياطى التلقائي حدد المسار الكامل الذي تريد حفظ قواعد بيانات النسخ الاحتياطي.فيه عن طريق النقر على الزر "تحديد مسار التخزين" وهذا المسار يجب بالفعل أن يكون موجوداً أو سوف يتم إحباط العملية. ــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــ ثالثاً : إعدادات وقت النسخ الإحتياطي التلقائي تحديد وقت بدء النسخ الإحتياطي التلقائي هام جداً جداً جداً أدخل الوقت بهذا التنسيق (HH:MM:SS AM / PM) شرح التسيق HH الساعة MM الدقيقة SS الثانية AM / PM أو ص / م وهذا يشير لتحديد الساعة صباحا او مساءً ويظهر هذا التنسيق فقط عندما تكون إعدادت نظام التشغيل تم تحديد الوقت فيه على نظام 12 ساعة مثال عندما نريد نسخ تلقائى فى تمام الساعة الواحدة ظهراً تكون بهذا الشكل (01:00:00 م ) وفي حالة ضبط إعدادت الوقت فى نظام التشغيل 24 ساعة يكون التسيق (HH:MM:SS) مثال عندما نريد نسخ تلقائى فى تمام الساعة الواحدة ظهراً تكون بهذا الشكل (13:00:00) ــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــ ملاحظـــــة هامــــــــة ـــــــــــــــــــــــــــــــــــ لكى يتم عمل النسخ التلقائي لقواعد البيانات بشكل تلقائي طبقاً للإعدادت المسبقة 1- يجب فتح النموذج المسئول عن النسخ الإحتياطي التلقائي من خلال النقر على الزر "بدء النسخ الاحتياطي التلقائي" وإلا لن يتم النسخ الاحتياطى تلقائيا فى الوقت المحدد طبقاً للإعدادت المحددة 2- فى حالة إستخدام شاشة التوقف أو شاشة حماية إذا كنت ترغب فى الحصول على السرية والحماية للجهاز الخاص بك فى غيابك لن يؤثر ذلك على النسخ التلقائي ☺ ملاحظة هامة جدا جدا جدا يتم تحديد قاعدة بيانات أو أكثر لعمل نسخ احتياطى لها وضغط واصلاح مرة واحدة فقط من الاعدادت يتم تحديد المسار المراد حفظ النسخ الاحتياطى مرة واحدة فقط وقمت بعمل طريقة تجعل البرنامج يقوم كل يوم بعمل مجلد باسم وتاريخ اليوم دون اى تدخل من المستخدم فقط غير فتح النموذج "frmTimer" مشكلة لو تم وضع باسورد لحماية قاعدة البيانات المراد عمل نسخ احتياطى لها عند فتحها فلن يكتمل النسخ التلقائى الالى بسبب كلمة السر هذه ولن يتم عمل اى نسخ احتياطى لباقى قواعد البيانات الاخرى للامانة العلمية : هذا البرنامج حصلت عليه من احد المنتديات الاجنبية ولكن قمت بتعديلات كثيرة جدا للوصول الى هذه النتيجة المثمرة ان شاء الله واضعها بين أيديكم حتى تعم الفائدة AutoBackup.rar

السلام عليكم ورحمة الله تعالى وبركاته كنت قد بدات هذا الموضوع من قبل وهو خاص بجعل العميل يرسل لك تقييم عن برنامجك او رسالة خاصة بالاخطاء الفنيه . كل هذا يرسله العميل لك بالبريد الاليكترونى ووجدنا انه من الصعوبة فتح كل بريد وارد لرؤية اللتقييم به ومن الصعب الحصول على فلترة لتلك الايمالات لاستخلاص منها درجات التقييم خاصة وان كان عدد مبيعات برامجك كبيرة فهدانا الله الى انشاء قاعدة بيانات لتكون منصة لاستقبال البيانات التى يرسلها عملاؤنا من جميع انحاء العالم وكان السؤال كيف سيتم الاستغناء عن ارسال ميل خاص بكل تقييم ؟؟ وكيف سيتم ربط قاعدة البيانات لديك كمصمم بكل برنامج تبيعه لعملاؤك لمعرفة ذلك يرجى متابعة هذا الموضوع بكل صفحاته بتعليقاته شرح بسيط مع الصور صورة نموذدج التقييم ملاحظة بسيطة ارجو كتابة الاسم عند ارسال التقييم فى زر ارسال التقييم قمت بادراج كود الربط الذى سيربط نموذج التقييم بالجدول المرفوع على سيكوال سيرفير هذا الكود ستجدونه هنا فى موقع ميكروسوفت الرسمى https://support.microsoft.com/en-us/kb/892490 والان منصة استقبال التقييمات وهو عبارة عن نموذج مربوط برمجيا بقاعدة سيكوال سيرفير هذا النموذج يمكنه الاتصال بكل برنامج تبيعه للعملاء دن الحاجة الى ستقبال الميل لن يتم ارفاق قاعدة البيانات الخاصة باستقبال التقييمات الان فقط سيتم ارفاق نموذج التقييم فقط وارجوا منكم ارسال تعليقاتكم وتقييماتكم من نموذج التقييم وهى ستصلنى ان شاء الله وسارفقها لاحقا نموذج التقييم.rar

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

السلام عليكم ورحمة الله وبركاته اكتب N=N+2 بدلا من N=N+1 ثم اضف Range("A" & N) = (N - 11) / 2 قبل عبارة End With

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

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

ماشى يا كبيرنا مش بقولك مبتدأ فى اول الطريق

انت رائع ،، قمت وبنفس الطريقة بتسجيل مايكرو واعطاني نفس الكود. جزاك الله خيرا ،،

تم التحميل جزيت خيرا

جزاكم الله خيرا جارى التحميل والتجربة............................

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

وعليكم السلام ورحمة الله وبركاته رابط آخر على الميديا فاير http://www.mediafire.com/download/6996qz5l077zqc1/العيادة.accdb للدخول لقاعدة البيانات 123 جزاكم الله خيراً

بارك الله فيك وجزاك الله خيراً أخي العزيز جلال الجمال تم تعديل رابط الملف المرفق ، للاستفادة البسيطة جداً من مشاهدة وتحميل الملف (أرجو ألا يضايقك الأمر) تقبل تحياتي

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

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

بارك الله فيك أخي الحبيب أبو حنين وجزيت خيراً على كل مساهماتك الرائعة والجميلة وبصراحة أنت ملك الفورم لي رجاء عندك ويا ريت تلبيه .. أرجو دائماً في كل مشاركاتك أن تضع الكود في المشاركة للإطلاع عليه قبل تحميل الملف أخي السائل (حتى منعرفش اسمه لحد الآن) روح للكود في الفورم وابحث عن هذا السطر Me.Controls("T" & I) = "" وغير I إلى xx ... ولي رجاء أن تقسم موضوعك إلى نقاط بسيطة لكي تجد الاستجابة من قبل إخوانك بالمنتدى (وراجع التوجيهات لتعرف كل الأمور التي يستحب الالتزام بها)

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

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

هذا توضيح بالصورة لما يريده الأخ السائل (داخل الخلية الواحدة) الأمر يحتاج لكود . فمن يسعفنا به ؟

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

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

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

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

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

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

وانا ايضا لابد لي من تغير النظارة ملفك القوئم لا تعمل

وجزيت خيراً أخي الكريم أبو سلمان ببساطة يوضع سطر لفك الحماية في بداية الكود وفي نهاية الكود يوضع سطر لوضع الحماية مرة أخرى Activesheet.Unprotect 123 هذا السطرلفك الحماية بفرض أن كلمة السر 123 .... لإرجاع الحماية ستستخدم نفس السطر بالضبط وتحذف منه فقط حرفين Un ... أرجو أن يفي هذا بالغرض

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

يمكنك أن تقوم بعملية فلترة للتاريخ ولكن رجاءً ضع بيانات في الملف المرفق فيما لا يقل عن 15 أو 20 صف للعمل عليها ولتجربة الكود اللازم .. وسؤال هل هناك شروط أخرى غير التاريخ الموجود في الخلية B3؟؟ وهل تريد إزالة الفلترة بعد الطباعة أم تريد الفلترة فقط ... وزر الطباعة سيكون مخصص له زر آخر؟

الأخ محمد ربما يفيدك الملف التالي إلى حين إرفاق ملفك الأصلي ولكن الفكرة واحدة حيث يتم كتابة التاريخين ، وإذا كان تاريخ واحد يكتب التاريخ في الخليتين ...ثم يتم جلب البيانات وإعداد التقرير Report Data Between Two Dates.rar

ريثما ترسل الملف شاهد هذا https://youtu.be/Rx4xaOs--Xs

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

و عليكم السلام و رحمة الله تعالى و بركاته كل عام و الأمة الإسلامية بخير إن شاء الله

شفت لما الموضوع بقا واضح لقيت الحل علطول إزاي ؟؟!! عشان متتعصبش علينا .. وامسك أعصابك يا أبو الفتوح يا روح الروح إليك المعادلة التالية وهي معادلة صفيف (يعني بعد ما تدخل المعادلة في الخلية الهدف قوم بالضغط على 3 مفاتيح مع بعض CTRL + SHIFT + ENTER) والحل دا هيغنيك عن استخدام أعمدة مساعدة =INDEX($D$2:$D$6,MATCH(C12&""&D12,$C$2:$C$6&""&$E$2:$E$6,0)) & "-" & INDEX($F$2:$F$6,MATCH(C12&""&D12,$C$2:$C$6&""&$E$2:$E$6,0)) لو حصل معاك خطأ غير الفاصلة العادية في المعادلة إلى فاصلة منقوطة ... والحمد لله أن تم المطلوب والموضوع على خير

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

الطريقة الثانية VB.rar

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

أخي الحبيب سليم بارك الله فيك وجزاك الله كل خير بينما كنت تقدم الحل لأخونا محمد السباعي كنت منهمك في الكود التالي (الذي تعدى معي حد الجنون ..!! أكثر من ساعة ونصف وربما ساعتين في هذا الكود) هو كود مجنون بحق .. حاولت فيه بقدر المستطاع أن أجعله كون مرن يصلح لأي موضوع شبيه بهذا الموضوع (خصوصاً أن هذا الموضوع يتكرر في كثير من الأحيان) وهو أن يكون هناك ورقة عمل رئيسية بها عمودوالمطلوب ترحيل القيم في هذا العمود إلى الورقة المناسبة ، وأضفنا إليه من قبل إمكانية إنشاء ورقة عمل إذا لم تكن موجودة .. الكود المجنون من العيار الثقيل وأرجو أن يبدي الأعضاء أي ملاحظات عليه لتطويره بحيث يصلح لهذه المشكلة أياً كان شكلها وحجمها وأبعادها ... الكود بالشكل التالي Sub Transfer_Data_Using_Filter_By_List() 'Author : YasserKhalil 'Release : 01 - 09 - 2016 '------------------------ Dim dictPerson As Object, dictSheet As Object, mtx(), isFound As Boolean Dim I As Long, v1 As Variant, v2 As Variant, arr As Variant, arrCol As Variant Dim rng As Range, arrHeader As Variant Dim cnt As Integer, counter As Integer Dim Rc As Long, Gc As Long, Bc As Long '=========================================================================================== 'Column Number To Be Filtered Const iCol As Integer = 5 'Sheet Name (The Source Sheet) Const sSheet As String = "DATA" 'Data Range Including Header Set rng = Sheets(sSheet).Range("A5:E" & Sheets(sSheet).Cells(Rows.Count, iCol).End(xlUp).Row) 'Row Number For Destination Sheets (5 = Row 5) Const destRow As Integer = 5 'Column Number For Destination Sheets (1 = Column A) Const destCol As Integer = 1 'Column Widths For Output Sheets arr = Array(14, 50, 15, 14) 'Columns Order To Be Copied. So Column 4 In Data Sheet To Be Copied To Column 1 To Destination Sheet arrCol = Array(4, 3, 1, 2) 'Columns Order To Be Copied. So Column 4 In Data Sheet To Be Copied To Column 1 To Destination Sheet arrHeader = Array("القيمة", "البيان", "التوجيه المحاسبي", "التاريخ") '=========================================================================================== Application.ScreenUpdating = False mtx = rng.Value Set dictPerson = CreateObject("Scripting.Dictionary") For I = 2 To UBound(mtx, 1) If Not dictPerson.Exists(mtx(I, iCol)) Then dictPerson.Add mtx(I, iCol), mtx(I, iCol) Next I Set dictSheet = CreateObject("Scripting.Dictionary") For I = 1 To Worksheets.Count If Not dictSheet.Exists(Worksheets(I).Name) Then dictSheet.Add Worksheets(I).Name, Worksheets(I).Name Next I dictSheet.Remove (sSheet) For Each v1 In dictPerson isFound = False For Each v2 In dictSheet If v1 = v2 Then isFound = True Exit For End If Next v2 If Not isFound Then If MsgBox(v1 & " Does Not Exist." & vbCrLf & "Create This Sheet ? ", vbOKCancel) = vbOK Then Worksheets.Add After:=Sheets(sSheet) ActiveSheet.Name = v1 ActiveSheet.DisplayRightToLeft = True Else dictPerson.Remove v1 End If End If Next v1 For Each v1 In dictPerson Sheets(v1).Cells.Clear rng.AutoFilter Field:=iCol, Criteria1:=v1 With rng.Offset(1) For counter = LBound(arrCol) To UBound(arrCol) .Columns(arrCol(counter)).SpecialCells(xlCellTypeVisible).Copy Sheets(v1).Cells(destRow + 1, destCol + counter).PasteSpecial xlPasteValues Sheets(v1).Columns(destCol + counter).NumberFormat = .Columns(arrCol(counter)).NumberFormat Next counter Sheets(v1).Cells(destRow, destCol).Resize(1, UBound(arrHeader) + 1).Value = arrHeader End With With rng(1, 1) Rc = .Interior.Color Mod 256 Gc = Int(.Interior.Color / 256) Mod 256 Bc = Int(Int(.Interior.Color / 256) / 256) Sheets(v1).Cells(destRow, destCol).Resize(1, UBound(arrHeader) + 1).Interior.Color = RGB(Rc, Gc, Bc) End With With Sheets(v1) With .Cells .ReadingOrder = xlRTL .Font.Name = "Arial" .Font.Size = 11 .HorizontalAlignment = xlCenter: .VerticalAlignment = xlCenter .RowHeight = 19 .ColumnWidth = 9 End With With .Cells(destRow - 1, destCol) .Offset(1).CurrentRegion.Borders.Value = 1 .Value = v1 .Resize(1, UBound(arrHeader) + 1).Interior.Color = vbYellow .Resize(1, UBound(arrHeader) + 1).HorizontalAlignment = xlCenterAcrossSelection End With With .Rows(destRow - 1).Resize(2) .RowHeight = 25 .Font.Bold = True .Font.Size = 13 End With For cnt = LBound(arr) To UBound(arr) .Columns(destCol + cnt).ColumnWidth = arr(cnt) Next cnt Application.Goto .Range("A1") End With Next v1 Application.Goto Sheets(sSheet).Range("A1") rng.AutoFilter Application.CutCopyMode = False Application.ScreenUpdating = True MsgBox "Done...", 64 End Sub فمت بوضع التعليقات باللغة الإنجليزية (معلش تعود مش أكتر) سأقوم بشرحها لمن يهمه الأمر أول سطر في التعليق يتعلق برقم العمود الذي يحتوي على القيم التي سيتم فلترتها السطر التالي يكتب اسم ورقة العمل التي تحتوي على البيانات (الورقة الرئيسية) السطر التالي نطاق البيانات المراد العمل عليها السطر التالي رقم الصف المراد وضع البيانات فيه السطر التالي رقم العمود المراد وضع البيانات فيه .. مثال لو أردنا وضع البيانات في الخلية H3 هذا يعني أن رقم الصف هو 3 ورقم العمود هو 8 السطر التالي عرض الأعمدة في المخرجات ..بما أننا تعاملنا في المخرجات مع 4 أعمدة فيكتب 4 أرقام ..يمكنك ببساطة زيادة أو نقصان العدد السطر التالي ترتيب الأعمدة وهذا السطر مهم للغاية ..فقد لاحظت أن الترتيب ليس بالضبط كترتيب الورقة الرئيسية وهذا ما دفعني إلى كتابة الكود في الحقيقة .. المهم هنا الرقم 4 هو رابع عمود في ورقة البيانات ، والرقم 3 هو ثالث عمود في ورقة البيانات ، والرقم 1 أول عمود في ورقة البيانات ، والرقم 2 هو ثاني عمود في ورقة البيانات ، وسيتم ترحيلهم بنفس الترتيب إلى الأوراق الجديدة السطر التالي هو خاص بالعناوين التي ستوضع في الأوراق الأخرى والتي سيتم ترحيل البيانات إليها ، وقد قمت بذلك أيضاً لأنني لاحظت أن هناك تغيير في العناوين (العمود "مدين" يسمى في المخرجات باسم "القيمة") المهم الأربعة سطور الأخيرة يجب أن يكون كل منها محتوي على 4 عناصر حسب عدد الأعمدة المطلوبة في المخرجات أسأل الله العظيم أن يكون الكود مفيد لكم وأعتذر عن الإطالة .. ولكن كان لابد من التوضيح التام لما هو مهم في الكود لتتمكنوا من استخدامه بسهولة ويسر .. لتجربة الكود بشكل أعمق اختر في الخلية E12 ايصال تسوية ، وهي ورقة عمل غير موجودة لتشاهد ورقة العمل وهي تنشأ وتوضع فيها البيانات .. ولك الحرية في تلك النقطة (لك أن تنشيء ورقة العمل أو تلغي ... لابد أن يكون هناك مرونة) تقبلوا وافر تقديري واحترامي رابط الملف المرفق من هنا

أين المرفق أخي الكريم حسين؟