علاء رسلان قام بنشر نوفمبر 11, 2013 قام بنشر نوفمبر 11, 2013 السلام عليكم أثقل عليكم اليوم بلمف ثقيل للغاية و متخم بالبيانات و هذا ثالث موضوع لى فى هذا المنتدى الرائع .. اعرفكم بنفسى محدثكم علاء رسلان محاسب و مشرف بمنتدى آخر بقسم الأذكياء .. لندخل فى صلب الموضوع مباشر الملف المرفق حوالى 8 ميجا بعد فك الضغط و هو ملف اكسيل يحتوى أوراق عديدة لى طلبين الأول : اريد معادلة او صيغة للحصول على البيانات فى ورقة واحدة العمود المسمى Code و هو C و العمود المسمى Net Weight و هو K فى عمودين متجاورين بورقة واحدة .. لاحظوا معى ان نهايات البيانات فى كل ورقة مختلفة و هناك خلايا فارغة الثانى : اريد معادلة تقوم بجمع اوزان كل كود على حدى بورقة واحدة العمودين بالأساس Code سيارات Net Weight حمولة السيارة ( أوزان ) بمعنى اننى اريد الحمولة الشهرية لكل سيارة بورقة واحدة لكل السيارات . ملف العمل لا صلاحيات لدى للتعديل عليه فهو يأتى بهذه الصورة من ادارة اخرى و اقوم ان بتصفية الملف و القيام بما اطلبه منكم يدويا ورقة ورقة عن طريق نسخ و لصق الأعمدة المطلوبة ورقة وراء اخرى ثم التصفية و التنقية ثم التجميع و هذا بخلاف مخاطر نسيان ورقة او تسجيلها مرتين .. شكرا لكم جميعا دمتم بخير و اعزكم الله maste.rar
احمدزمان قام بنشر نوفمبر 12, 2013 قام بنشر نوفمبر 12, 2013 الثلاثاء 9/1/1435هـ الموافق 12/11/2013م السلام عليكم و رحمة الله وبركاته تم عمل الكود التالي: Dim SH, SH1, SH2, SH3, TR, FR Dim FS As Worksheet, TS As Worksheet Sub CLCT_ALL_CARS_MILEG() On Error Resume Next SH1 = Sheets.Count SH2 = "TOTALS" & SH1 Sheets.Add ActiveSheet.Name = SH2 Sheets(SH2).Move After:=Sheets(SH2) Set TS = Sheets(SH2) TR = 1 For SH3 = 1 To SH1 SH = Sheets(SH3).Name If Val(SH) > 0 And Val(SH) < 32 Then Set FS = Sheets(Sheets(SH).Name) ER = FS.UsedRange.Rows.Count For FR = 1 To ER If FS.Cells(FR, 3) <> "" And FS.Cells(FR, 1) <> "" Then If IsError(FS.Cells(FR, 3)) Or IsError(FS.Cells(FR, 10)) Then GoTo 9 TS.Cells(TR, 1) = FS.Cells(FR, 3) TS.Cells(TR, 2) = FS.Cells(FR, 10) TR = TR + 1 End If 9 Next FR End If Next SH3 TS.Select ER = TS.UsedRange.Rows.Count Range("A1:A" & ER).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("D1"), Unique:=True ER = Range("D65535").End(xlUp).Row Range("E2:E" & ER).FormulaR1C1 = "=SUMIF(R1C1:R9999C1,RC4,R1C2:R9999C2)" TS.Calculate Range("D1:E" & ER).Copy Range("D1:E" & ER).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False [E1] = [B1] Range("D1:E" & ER).Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Range("A1:B1").EntireColumn.Delete End Sub وهذا الكود يقوم بالخطوات التالية ادراج ورقة جديدة المرور على كل اوراق الملف ونسخ الخلايا C , K من كل ورقة الى الورقة الجديدة استخراج بيان غير مكرر لأرقام اللوحات من العمود A غير مكرر الى العمود D في الورقة الجديدة استخدام الدالة SUMIF في العمود E لحساب مجمل كل سيارة في العمود D فقط تثبيت قيم الدالة فرز البيانات حسب رقم اللوحة حذف العمودين A,B قد أخذ الكود وقت طويل يصل الى 15 دقيقة حسب كثرة البيانات مع التحية maste.rar
علاء رسلان قام بنشر نوفمبر 12, 2013 الكاتب قام بنشر نوفمبر 12, 2013 و عليكم السلام ورحمة الله و بركاته شكرا جزيلا و لى عودة ان شاء الله بعد التجربة .. لدى واجب عزاء الليلة و سأعود لاحقا لموفاتك بالنتيجة .. عموما اكتشفت شئ آخر لم انتبه اليه و هو ان الصفحة الأولى فقط الأوزان بالعمود K اما بقية الصفحات فالأوزان بالعمود J عموما سأجرب ما افدتنى به و اقوم بالتعديل بما يناسب الوضع الجديد ان شاء الله شكرا لك مرة ثانية عتاب على الهامش للأستاذ محمود الأسيوطى أرسلت رسالتين لك و لم ترد على اى منهما بشئ عموما ألتمس العذر لك حتى يشاء الله لى بالرحيل .. دمت بخير و أعزك الله
ابو اياد ( الاسيوطى ) قام بنشر نوفمبر 12, 2013 قام بنشر نوفمبر 12, 2013 السلام عليكم أخى الحبيب // علاء رسلان أخى إلتمس لأخيك الاسيوطى العذر فأنت لا تعلم ما هى ظروفى ولا ظروف عملى ولا ظروف عائلتى فأنا والله يعلم أحاول المساعده قدر استطاعتى من وقت وجهد واحاول ان لا اقصر مع اى عضو قدر المستطاع اخى الحبيب ارجو أن لا تغضب او تتدايق فوقتى هذه الايام ضيق جدا انت تعلم نحن فى شهر 11 والميزانيه تدق الابواب ونحن نلهس من كثره العمل وطول وقته وان اختطفت خلسه دون ان يدرى احد ان ادخل الى المنتدى لأرى ما يمكننى ان اساعد او اتعلم .........الخ سامحنى على تقصيرى حتى لا يتأنب ضميرى !!!!!!!!!!!!!! برغم انى اعلم جيدا ان هناك اخوه اكثر منى خبره يساعدوك ان توفر وقتهم وحظك كبير فأستاذنا الكبير // احمد زمان قام بمساعتك وتنفيذ مطلوبك ان شاء الله وان شاء الله معك وألقى نظره على الملف واحاول معك فى تنفيذ ماتريد والله الموفق للجميع . واخيرا اقدم لك اعتزارى ولكن والله غصب عنى . تقبل تحياتى واحترامى اخيك // الاسيوطى ملحوظه : احيانا كثيره اكون بالمنزل واترك الجهاز مفتوح على موضوع معين واذهب الى تلبيه بعض حاجه العائله مبدئيا أليك ملفك بدون عمل ايه معادلات فقط قمت بتحويل امتداده الى Binary اصغر حجما واسرع اداءا ووحده وحده كده مع بعض عشان مش فاهم حاجه دماغى Over اخر حاجه من الشغل 10 ساعات متواصله maste1.rar
علاء رسلان قام بنشر نوفمبر 12, 2013 الكاتب قام بنشر نوفمبر 12, 2013 و عليكم السلام و رحمة الله و بركاته عتاب الأحبة أخى الكريم الأستاذ محمود الأسيوطى .. ملتمس العذر لك طبعا حتى آخر نفس لدى و طبعا الطاحونة السنوية ستبدأ عملها على هرسنا جميعا من مراجعات و جرود لتقفيل الحسابات حتى نحن شهريا نقوم بعمل تقفيل مع الحسابات و ادارات اخرى و الطحنة الكبرى السنوية ..قام الأخ الأستاذ احمد زمان بجهد فائق للغاية و سأحاول فهم الكود لتعديله بما يناسبنى تماما و سأقوم بمراجعة ملفك المرفق ان شاء الله و يسعدنى كثيرا التواجد فى هذا المنتدى الرائع و تعلم شئ مفيد لعملى . دمتم بخير جميعا و اعزكم الله .
ابو اياد ( الاسيوطى ) قام بنشر نوفمبر 12, 2013 قام بنشر نوفمبر 12, 2013 ان شاء الله انتظرك واتمنى ان يكون حل استاذنا الكبير // احمد زمان هو ماتريد
علاء رسلان قام بنشر نوفمبر 15, 2013 الكاتب قام بنشر نوفمبر 15, 2013 النتيجة لا تطابق التجميع النهائى و ضبطت الأعمدة بحيث تتطابق مع الكود النتيجة غير مطابقة لا اعرف لماذا ؟ اريد التركيز على المطلوب الثانى مع تعديل الكود اريد ان يتم البحث عن العمودين المعنونين Code Net Weight فى جميع الأوراق من ورقة 1 الى 31 ايا كان موقع العمود بالورقة و نسخ محتوياتهم من كل الأوراق فى ورقة واحدة مع استبعاد القيم النصية و الفارغة و 0 ثم تجميع أوزان كل سيارة على حدى مع الترتيب بحسب كود السيارة .
ابو اياد ( الاسيوطى ) قام بنشر نوفمبر 24, 2013 قام بنشر نوفمبر 24, 2013 الاخ الكريم // علاء رسلان ان شاء الله اود ان اساعدك ولكنى كما تعلم فى ضغط العمل ان شاء الله بعد العمل معاك وربنا يوفقنا جميعا انتظرنى
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.