الشيباني1 قام بنشر يناير 20, 2009 قام بنشر يناير 20, 2009 اخواني الاعزاء تحية طيبه في احد البرامج التي استخدمها تفاصيل لما يقرب من (500) قائمه كما في المرفق ، اود مساعدتكم بكود وقائمه منسدله توصلني الى تفاصيل القائمه بمجرد ضغط رقمها مع الشكر _____.rar
gadelrab قام بنشر يناير 20, 2009 قام بنشر يناير 20, 2009 اخى العزيز الملف المرفق اتمنى ان يكون هو المطلوب وقد استخدمت فيه الدالة VLOOK2ALL للاستاذ العزيز عمر الحسينى فقط اجعل العمود الاول هو الخاص بالقائمة واكتب الخلايا الفارغة بالبيانات الصحيحة 1_____.rar
عادل حنفي قام بنشر يناير 20, 2009 قام بنشر يناير 20, 2009 السلام عليكم اخي جرب هذا الملف تحياتي _____.rar
الشيباني1 قام بنشر يناير 21, 2009 الكاتب قام بنشر يناير 21, 2009 ألاخوة الاعزاء تحية طيبه في الوقت الذي اشكركم فيه على سرعة الرد وروعته اود ايضاح ما يلي : 1-الحل الاول اقرب للمطلوب متسائلا عن امكانية وضع ورقة (تفاصيل) ضمن (ورقة1)وما الذي يتحتم علي تغييره عند نسخ الاكواد الى ورقة العمل التي اعمل عليها . 2-الحل الثاني يؤشر رقم القائمه فقط اي لا يمكن الذهاب الى تفاصيلها كما هو الحال في الحل الاول والذي اطمح اليه هو الوصول الى تفاصيل القائمه بمجرد الضغط على رقم القائمه من المنسدله بدلا من البحث عنها . مع الشكر والامتنان
عادل حنفي قام بنشر يناير 21, 2009 قام بنشر يناير 21, 2009 السلام عليكم اخي العزيز هل تقصد هكذا تحياتي _____.rar
gadelrab قام بنشر يناير 21, 2009 قام بنشر يناير 21, 2009 الاخ العزيز aah_aah200 حل اكثر من رائع ولى طلب ارجو ان تلبيه ما هو المكرو الذى تم عمل القائمة الموجود بصفحة ترتيب القوائم والتى على اساسها تم عمل القائمة المنسدلة اريد فقط الماكرو الذى يضيف بصفحة ترتيب القوائم اى اضافة جديدة الى خانة القائمة وجزاك الله خير الجزاء
عادل حنفي قام بنشر يناير 21, 2009 قام بنشر يناير 21, 2009 (معدل) السلام عليكم اخي gadelrab اشكرك اخي علي كلماتك و الكود يتم علي مرحلتين الاولي عند الضغط علي الزر فيتم نسخ محتوي عمود القائم و ياكتف صفحة ترتيب القوائم ولصقه بها ولكي نجعل الكود الموجود بصفحة ترتيب القوائم يوجد في الكود الموجود ايضا عند الضغط علي الزر ناكتف صفحة1 ثم ناكتف صفحة ترتيب القوائم ليعمل الكود الذي بها ثم ناكتف مرة اخري صفحة 1 و هكذا يكون القائمة المنسدله جاهزه للعمل و الكود الموجود بصفحة تريب القوائم هذا هو و هو منقسم لقسمين احدهما لازالة المكرر و الاخر للترتيب Private Sub Worksheet_Activate() If Range("B1") = "0" Then Exit Sub Else On Error Resume Next Range("A2:A500").SpecialCells(xlCellTypeBlanks).EntireRow.Delete ActiveSheet.UsedRange End If Dim x As Long Dim LastRow As Long LastRow = Range("A400").End(xlUp).Row For x = LastRow To 1 Step -1 If Application.WorksheetFunction.CountIf(Range("A2:A" & x), Range("A" & x).Text) > 1 Then Range("A" & x).EntireRow.Delete End If Next x Range("A3:A100").Sort Key1:=Range("A3"), Order1:=xlAscending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal End Sub خالص تحياتي تم تعديل يناير 21, 2009 بواسطه aah_aah2008
الشيباني1 قام بنشر يناير 22, 2009 الكاتب قام بنشر يناير 22, 2009 أخواني الاعزاء مع تقديري واعجابي بجميع الحلول المقدمه ارفق طيا نسخة طبق الاصل لورقة العمل التي اعمل عليها راجيا تدخلكم لوضع الاكواد التي تضمنتها الحلول ضمنها لتسهيل نقلها مع الامتنان _____3.zip
عادل حنفي قام بنشر يناير 23, 2009 قام بنشر يناير 23, 2009 السلام عليكم اخي tofimoon4 اتمني ان يكون هذا هو المطلوب تحياتي s_____.rar
الشيباني1 قام بنشر يناير 25, 2009 الكاتب قام بنشر يناير 25, 2009 استاذنا العزيز ، تحية طيبه، حيث اني لم اوفق في الوصول الى الغاية المطلوبه بعد اجراءي التغيير اللازم على المرفق الاخير ، ارجو المساعده في : 1-تغيير اسم ( ورقه1) ليكون (المبيعات). 2-كيفية عمل ودور ورقة ترتيب القوائم في هذا الحل . 3-في عمود القائمه انا احاول تنزيل ارقام القوائم امام كل رمز للماده للاستفاده حين الفرز ، اي تنزيل الرقم (1) كما في المثال امام كل ماده وهكذا بقية الارقام . شاكرا جهودكم الخيره مع الامتنان
عادل حنفي قام بنشر يناير 26, 2009 قام بنشر يناير 26, 2009 السلام عليكم اخي العزيز صفحة ترتيب القوائم لا تحتاجها انت في شيئ بل يحتاجها البرنامج لانها تخدم القائمة المنسدله و هي ايضا التي يتم بها فرز المكرر من القوائم و ترتيبه عموما قد قمت بجعلها تعمل بالخفاء حتي لاتربكك و تم التغيير لصفحة المبيعات بدلا من ورقة1 و تم جعلك تتمكن من انزال اسم القئمة امام رموز القائمة و التعديل بناء علي هذا تم عمل هذا الكود ليمل حتي 10000 صف ارجو التجربة و اخباري بالنتيجة تحياتي _____.rar
الشيباني1 قام بنشر يناير 28, 2009 الكاتب قام بنشر يناير 28, 2009 استاذنا العزيز مع احترامي وتقديري لجهدكم الرائع وصبركم علينا يظهر انني لم اوفق ثانية في التوصل الى المراد والسبب هو ورقة ( ترتيب القوائم ) صحيح انها مخفيه ولكنها ضروريه عند رغبتي نقل محتويات المثال الى برنامجي الذي اعمل عليه . الرجاء ايضاح كيفية ادخال ارقام القوائم فيها ( كيفية الاعداد ) حيث ان برنامجي يحوي ما يقارب ال( 500 ) قائمه تحتاج التفاتة رائعه منكم في كيفية ادخالها في هذه القائمه لتعمل الاكواد بصورة طبيعيه مع الامتنان
عادل حنفي قام بنشر يناير 28, 2009 قام بنشر يناير 28, 2009 (معدل) السلام عليكم اخي العزيز اولا و كما قلت سابقا ان الكود يعمل و حتي الصف ال10000 مما يتيح العمل علي مجموعة قوائم كبيرة ثانيا كل ماعليك انشاء شيت اسمه ترتيب القوائم مع دعمه بالاكواد الخاصة به بملفي و لن تكتب به اي شئ فهو كصفحة مساعدة فقط يتم نسخ القوائم به و الغاء المكرر ثم الترتيب(هذا كله بالكود طبعا) لتظهر القائمة المنسدلة كما هي الان ارجو ان تكون المعلومة وصلت و لو فيه اي شئ اخبرني تحياتي تم تعديل يناير 29, 2009 بواسطه aah_aah2008
الشيباني1 قام بنشر فبراير 8, 2009 الكاتب قام بنشر فبراير 8, 2009 استاذنا العزيز تحية واحترام اولا اعتذر عن التاخر في شكركم على ما جادت به اناملكم من ابداع وثانيا لانني (وبسبب يعود لقلة خبرتي في الاكواد ) لم اوفق حتى الآن في التوصل الى المراد( بسبب ورقة ترتيب القوائم على ما اظن ) وسأعيد المحاولات حتى اصل بأذن الله أشكرك الشكر الجزيل وجزاك الله كل خير
أفضل إجابة عادل حنفي قام بنشر فبراير 8, 2009 أفضل إجابة قام بنشر فبراير 8, 2009 (معدل) السلام عليكم اخي العزيز tofimoon4 ما هو الذي يقف امامك اخي كل ما عليك هو الاتي انشاء صفحة و سمها باسم ترتيب القوائم و في محرر كودها الصق هذا الكود Private Sub Worksheet_Activate() If Range("B1") = "0" Then Exit Sub Else On Error Resume Next Range("A2:A10000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete ActiveSheet.UsedRange End If Dim x As Long Dim LastRow As Long LastRow = Range("A400").End(xlUp).Row For x = LastRow To 1 Step -1 If Application.WorksheetFunction.CountIf(Range("A2:A" & x), Range("A" & x).Text) > 1 Then Range("A" & x).EntireRow.Delete End If Next x Range("A3:A10000").Sort Key1:=Range("A3"), Order1:=xlAscending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal End Sub و الخليه B1 بهذه الصفحة بها معادله انسخها ايضا و الصقها في الخليه B1 جرب و قولي ما يحدث و نحن معك الي ان يتم ما تريد و اعتقد ان يكون هذا سبب المشكله في اول مره يعمل بها الكود في ملف جديد فقط قم بكتابة 1 في الخليه A3 وبعد ذلك سيكون العمل بشكل عادي فلسبب ما اجهله الان قمت بكتابة شرط ان الخليه B1 اذا كانت تساوي صفرا لا يعمل الكود و اكيد انا عملت ده لسبب ما لا اتذكره الان و حتي لا اكون متسرعا و اقولك الغي هذا الشرط قم بعمل ما قلته لك و ان شاء الله يعمل الملف معاك تحياتي تم تعديل فبراير 8, 2009 بواسطه aah_aah2008
dayslife قام بنشر فبراير 15, 2009 قام بنشر فبراير 15, 2009 Private Sub Worksheet_Activate() If Range("B1") = "0" Then Exit Sub Else On Error Resume Next Range("A2:A10000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete ActiveSheet.UsedRange End If Dim x As Long Dim LastRow As Long LastRow = Range("A400").End(xlUp).Row For x = LastRow To 1 Step -1 If Application.WorksheetFunction.CountIf(Range("A2:A" & x), Range("A" & x).Text) > 1 Then Range("A" & x).EntireRow.Delete End If Next x Range("A3:A10000").Sort Key1:=Range("A3"), Order1:=xlAscending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal End Sub يا حبذا استاذي العزيز شرح لهذا الكود لكي افهمه ... فلا استطيع ان اطبق شيء لا افهمه يا رب تتحمل اسئلتي يارب .............
amoudi قام بنشر فبراير 15, 2009 قام بنشر فبراير 15, 2009 يا حبذا استاذي العزيز شرح لهذا الكود لكي افهمه ... فلا استطيع ان اطبق شيء لا افهمه كلام جميل جدا واتمنى الجميع يكون يتبع نفس الأسلوب ,, اتمنى لك التوفيق
عادل حنفي قام بنشر فبراير 16, 2009 قام بنشر فبراير 16, 2009 السلام عليكم اخي dayslife Private Sub Worksheet_Activate() في حدث التفعيل للشيت If Range("B1") = "0" Thenاذا كانت الخلية B1=0 Exit Sub يتوقف عمل الكود Else اذا لم تكن =0 On Error Resume Next هذا كود لالغاء الخلايا الفارغة Range("A2:A10000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete ActiveSheet.UsedRange End If Dim x As Long و هذا كود اخر يؤدي نفس و ظيفة السابق استعنت به لان الاول و جدته لا يحذف الخلايا الفارغة بالكامل لسبب لم ابحث عنه في هذا الملف Dim LastRow As Long LastRow = Range("A400").End(xlUp).Row For x = LastRow To 1 Step -1 If Application.WorksheetFunction.CountIf(Range("A2:A" & x), Range("A" & x).Text) > 1 Then Range("A" & x).EntireRow.Delete End If Next x Range("A3:A10000").Sort Key1:=Range("A3"), Order1:=xlAscending, Header:= _و هذا كود لعمل الترتيب من الاصغر فالاكبر xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal End Sub تحياتي
amoudi قام بنشر فبراير 16, 2009 قام بنشر فبراير 16, 2009 السلام عليكم Dim x As Long و هذا كود اخر يؤدي نفس و ظيفة السابق استعنت به لان الاول و جدته لا يحذف الخلايا الفارغة بالكامل لسبب لم ابحث عنه في هذا الملفDim LastRow As Long LastRow = Range("A400").End(xlUp).Row For x = LastRow To 1 Step -1 If Application.WorksheetFunction.CountIf(Range("A2:A" & x), Range("A" & x).Text) > 1 Then Range("A" & x).EntireRow.Delete End If Next x اعتقد هذا كود لحدف المكرر تحياتي
ramies قام بنشر فبراير 16, 2009 قام بنشر فبراير 16, 2009 السلام عليكم اخوانا واساتذتنا الكرام لماذا نستخدم الماكرو فى كل حلولنا لمشاكل الاكسيل مع انه يمكن الحل بدون ماكرو لبعض المشاكل ارجوا اخبارى لو سمحتم وتقبلوا تحياتى اسماعيل
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.