طلبان لعمليات على ملف اكسيل

[علاء رسلان]

السلام عليكم

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

الأول : اريد معادلة او صيغة للحصول على البيانات فى ورقة واحدة

العمود المسمى Code و هو C

و العمود المسمى  Net Weight  و هو K

فى عمودين متجاورين بورقة واحدة .. لاحظوا معى ان نهايات البيانات فى كل ورقة مختلفة و هناك خلايا فارغة

الثانى : اريد معادلة تقوم بجمع اوزان كل كود على حدى بورقة واحدة

العمودين بالأساس

Code  سيارات

Net Weight  حمولة السيارة ( أوزان )

بمعنى اننى اريد الحمولة الشهرية لكل سيارة بورقة واحدة لكل السيارات .

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

دمتم بخير و اعزكم الله

 

 

 

maste.rar

[احمدزمان]

‏الثلاثاء‏  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

وهذا الكود يقوم بالخطوات التالية

1. ادراج ورقة جديدة
2. المرور على كل اوراق الملف ونسخ الخلايا C , K من كل ورقة الى الورقة الجديدة
3. استخراج بيان غير مكرر لأرقام اللوحات من العمود A غير مكرر الى العمود D في الورقة الجديدة
4. استخدام الدالة SUMIF في العمود E  لحساب مجمل كل سيارة في العمود D  فقط
5. تثبيت قيم الدالة
6. فرز البيانات حسب رقم اللوحة
7. حذف العمودين A,B

 

قد أخذ الكود وقت طويل يصل الى 15 دقيقة حسب كثرة البيانات

مع التحية

maste.rar

[علاء رسلان]

و عليكم السلام ورحمة الله و بركاته

شكرا جزيلا و لى عودة ان شاء الله بعد التجربة .. لدى واجب عزاء الليلة و سأعود لاحقا لموفاتك بالنتيجة .. عموما اكتشفت شئ آخر لم انتبه اليه و هو ان الصفحة الأولى فقط الأوزان بالعمود K

اما بقية الصفحات فالأوزان بالعمود J

عموما سأجرب ما افدتنى به و اقوم بالتعديل بما يناسب الوضع الجديد ان شاء الله شكرا لك مرة ثانية

عتاب على الهامش للأستاذ محمود الأسيوطى أرسلت رسالتين لك و لم ترد على اى منهما بشئ  عموما ألتمس العذر لك حتى يشاء الله لى بالرحيل

.. دمت بخير و أعزك الله

[ابو اياد ( الاسيوطى )]

السلام عليكم

أخى الحبيب // علاء رسلان 

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

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

لأرى ما يمكننى ان اساعد او اتعلم .........الخ

سامحنى على تقصيرى حتى لا يتأنب ضميرى !!!!!!!!!!!!!!

برغم انى اعلم جيدا ان هناك اخوه اكثر منى خبره يساعدوك ان توفر وقتهم وحظك كبير فأستاذنا الكبير // احمد زمان قام بمساعتك وتنفيذ مطلوبك ان شاء الله وان شاء الله معك وألقى نظره على الملف واحاول معك فى تنفيذ ماتريد والله الموفق للجميع .

واخيرا اقدم لك اعتزارى ولكن والله غصب عنى .

 

تقبل تحياتى واحترامى

 

اخيك // الاسيوطى

 

ملحوظه : احيانا كثيره اكون بالمنزل واترك الجهاز مفتوح على موضوع معين واذهب الى تلبيه بعض حاجه العائله 

 

مبدئيا أليك ملفك بدون عمل ايه معادلات فقط قمت بتحويل امتداده الى Binary اصغر حجما واسرع اداءا

 

ووحده وحده كده مع بعض عشان مش فاهم حاجه دماغى Over اخر حاجه من الشغل 10 ساعات متواصله

maste1.rar

[علاء رسلان]

و عليكم السلام و رحمة الله و بركاته

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

دمتم بخير جميعا و اعزكم الله .

[ابو اياد ( الاسيوطى )]

ان شاء الله انتظرك واتمنى ان يكون حل استاذنا الكبير // احمد زمان هو ماتريد 

[علاء رسلان]

النتيجة لا تطابق التجميع النهائى و ضبطت الأعمدة بحيث تتطابق مع الكود النتيجة غير مطابقة لا اعرف لماذا ؟ اريد التركيز على المطلوب الثانى مع تعديل الكود

اريد ان يتم البحث عن العمودين المعنونين

Code

Net Weight

فى جميع الأوراق من ورقة 1 الى 31

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

ثم تجميع أوزان كل سيارة على حدى مع الترتيب بحسب كود السيارة .

[علاء رسلان]

للرفع

[علاء رسلان]

للرفع

[علاء رسلان]

للرفع

[علاء رسلان]

للرفع

المشاركة 7

[علاء رسلان]

للرفع

[علاء رسلان]

للرفع

[علاء رسلان]

للرفع

[علاء رسلان]

للرفع

[علاء رسلان]

للرفع

[ابو اياد ( الاسيوطى )]

الاخ الكريم // علاء رسلان

ان شاء الله اود ان اساعدك ولكنى كما تعلم فى ضغط العمل

ان شاء الله بعد العمل معاك وربنا يوفقنا جميعا 

 

انتظرنى