عمل ليست من نطاق غير منتظم ومتكرر

[محمد خليل السيد]

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

 

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

 

 

 

Customer Report.rar

 

 

 

 

[عطاء الله]

وعليكم السلام أخي أحمد

إنتهيت من المشكل الأولى فواجهتك مشكلة الثانية  لا تخف في هذا المنتدى أعضاء متمكنين جدا في الإكسل 

مثل أحمد زمان حمادة بشا عبد الله المجرب  جمال عبد السميع حمادة  وحنين أم عبد الله السيوطي  سواء في المعادلات أو في الأكواد

أما محمد بقشير فهو كبيرنا الذي علمنا الإكسل لا يتدخل إلا في الأمور التي نعجز عليها

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

أظن هذا ماطلبته أنا عملته في ورقة واحد لضيق الوقت

وإن لم تفهم الشئ أرسلي

تقبل تحياتي

جرب وأرسلي

 

 

atallah.rar

[محمد خليل السيد]

السلام عليكم استاذى عطاء الله

 

اولا اسمى هو محمد خليل

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

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

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

 

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

تم تعديل نوفمبر 26, 2013 بواسطه mkh61083

[احمدزمان]

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

بعد اذن اخونا الفاضل الكريم عطاء الله

 

على حسب مافهمت من طلب اخونا محمدخليل

تم عمل الكود التالي

Dim FS As Worksheet, TS As Worksheet, RN1 As Range
Dim ER
Sub ãÇßÑæ1()
'
'Application.ScreenUpdating = False
Set FS = Sheets(ActiveSheet.Name)
ER = FS.UsedRange.Rows.Count
    Range("K2").EntireColumn.Insert
    Range("K2:K" & ER).FormulaR1C1 = "=IF(RC9="""",R[-1]C11,RC9)"
FS.Calculate
For R = 2 To ER
If Cells(R, 10) <> "" Then Cells(R, 9) = Cells(R, 11)
Next R

    Range("K2").EntireColumn.Delete
'I,J
Range("K1:L1").EntireColumn.Insert
ER = Cells(Cells.Rows.Count, "I").End(xlUp).Row
Range("K1").Clear
Range("I1:I" & ER).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("K1"), Unique:=True
'
ER = Cells(Cells.Rows.Count, "J").End(xlUp).Row
Range("L1").Clear
Range("J1:J" & ER).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("L1"), Unique:=True
'
Set RN1 = Sheets("ÇáãØáæÈ").Range("A1")
ER = Cells(Cells.Rows.Count, "K").End(xlUp).Row + 2
    FS.Range("K1:K" & ER).Copy
    RN1.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
ER = Cells(Cells.Rows.Count, "L").End(xlUp).Row + 2
    FS.Range("L1:L" & ER).Copy
    RN1.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
FS.Range("K2:L2").EntireColumn.Delete
RN1 = Date
Sheets("ÇáãØáæÈ").Select
Application.CutCopyMode = False
'Application.ScreenUpdating = TRUE
End Sub

ويبقى عملية الحساب

ويمكنك ذلك باستخدام الدوال

مثل SUMIFS - SUMPRODUCT

واتمنى ان اكون انجزت بعضا مما تريد

 

Customer Report2.rar

[عطاء الله]

أخي الكريم محمد خليل نحن لا نملو من أحد

وأي مشكلة تواجهك في العمل أو خارج العمل لا تتردد

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

إلا إذكانت أمور غير واضحة أو أسئلة مبهمة

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

تقبل تحياتي

احمد زمان كود رائع بارك الله فيك

[محمد خليل السيد]

اشكرك جدا استاذ / احمد زمان على الكود الممتاز لكن سأضع لك الملف الاصلى وكوبى منه لترى ماذا حدث عندما حاولت ان اطبق الكود .

اعذرنى لعدم اتقانى للاكواد

تقبل تحياتى

 

 

الملف الاصلى

Basic.rar

 

 

الملف الذى تم التجربه عليه

Copy.rar

 

وعذرا اخى على ثقل الملف 

[محمد خليل السيد]

أخي الكريم محمد خليل نحن لا نملو من أحد

وأي مشكلة تواجهك في العمل أو خارج العمل لا تتردد

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

إلا إذكانت أمور غير واضحة أو أسئلة مبهمة

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

تقبل تحياتي

احمد زمان كود رائع بارك الله فيك

 

بارك الله فيك يا استاذ عطاء الله

دعنى اوضح شيئا

  1- التقرير اسبوعى 

 2- عدد الصفوف فى التقرير الواحد يمكن ان يتعدى الـ 50000 صف

[احمدزمان]

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

 

اخي عطاء الله

اشكرك على متابعتك الدقيقة للموضوع

 

اشكرك جدا استاذ / احمد زمان على الكود الممتاز لكن سأضع لك الملف الاصلى وكوبى منه لترى ماذا حدث عندما حاولت ان اطبق الكود .

اعذرنى لعدم اتقانى للاكواد

تقبل تحياتى

 

 

الملف الاصلى

Basic.rar

 

 

الملف الذى تم التجربه عليه

Copy.rar

 

وعذرا اخى على ثقل الملف 

 

اخي محمد خليل

لم استطع فتح اي ملف من التي ارفقتها

الرجاء ارساله بصيغة 2003

او

قبل تطبيق الكود على الملف الأصلي

احفظ الملف باسم وضعه بصيغة اكسل عاديه xls

ثم طبق عليه الكود

 

تحياتي وتقديري

[محمد خليل السيد]

Report.rar

 

 

هذا هو الملف الاصلى بدون اى تعديل فيه

[محمد خليل السيد]

Copy of Report.rar

 

 

هذا هو الملف الذى تم التعديل فيه باستخدام الكود

 

[احمدزمان]

السلام عليكم

 

كل المشكلة تكمن في

الخلية I1 & H1

يجب ان تكتب بهما اي معلومة و لا تتركهما فارغتين

مثلا = النوع و اسم العميل

[احمدزمان]

في مشكلة في تغيير الموضع من راسي الى افقي

بسبب كثرة البيانات

وهنا

نحتاج فكرة جديدة للتنفيذ

[احمدزمان]

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

 

لايمكنني تنفيذ ما تطلب

السبب

عدد الأعمدة في اكسل 256 وعدد النتائج التي خرجت لدينا

النوع = 566 و اسم العميل 2689

 

اي اكثر من عدد الأعمدة

[محمد خليل السيد]

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

 

لايمكنني تنفيذ ما تطلب

السبب

عدد الأعمدة في اكسل 256 وعدد النتائج التي خرجت لدينا

النوع = 566 و اسم العميل 2689

 

اي اكثر من عدد الأعمدة

 

اشكرك جدا استاذ احمد على مجهودك

طيب الفكرة دى ممكن تتطبق على اوفيس اعلى مثلا 2007 او حتى 2013 مع بعض التعديلات 

[احمدزمان]

 

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

 

لايمكنني تنفيذ ما تطلب

السبب

عدد الأعمدة في اكسل 256 وعدد النتائج التي خرجت لدينا

النوع = 566 و اسم العميل 2689

 

اي اكثر من عدد الأعمدة

 

اشكرك جدا استاذ احمد على مجهودك

طيب الفكرة دى ممكن تتطبق على اوفيس اعلى مثلا 2007 او حتى 2013 مع بعض التعديلات 

 

 

العفو اخي الكريم

في حل آخر

نعمل القائمة طولية لكلا من اسم العميل و النوع

سوف احاول ان اوافيك بمثال

قريبا ان شاء الله تعالى

[احمدزمان]

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

 

اخي الكريم

نفذت افكاري ولم اجد حل لطلبك

 

قد يكون لدى احد العباقرة بالمنتدى فكرة للحل

I give Up

 

و انصحك بوضع طلبك في موضوع جديد

 

تحياتي وتقديري

[عطاء الله]

أخي احمد الزمان السلام عليكم

أشكرك على هذه المتابعة الطويلة للملف

لقد قدمت له حل في البداية بواسطة حيل الدوال ونجحت الفكر وأعطت نتائج 100/100

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

لأني لست في مستواك من ناحية  الأكواد أنا متوسط فقط

[احمدزمان]

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

اخي عطاء الله

جزاك الله خيرا

وفي انتظار ابداعاتك ومحاولاتك

دمت في نعمة الله وفضله

=================

[محمد خليل السيد]

استاذ / احمد زمان ، استاذ / عطاء الله

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

 

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

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

الاخ // عطاء الله

 

ارجو ان ترى هذا الرابط للأهميه

 

http://www.officena.net/ib/index.php?showtopic=50072&hl=

 

يمكن ان يغضب منك اعضاء كثير وارجو ان تعتنى بمن يوجه لك الكلام فى الرسائل الخاصه

 

للمره الاخيرة انتظرك 

[عطاء الله]

اين انت إفتقدناك  كيف احوالك لم أرى ردودك منذ فترة

أنا لم أعلم بهذه الترقية بارك الله فيك انقذتي

[عطاء الله]

السلام عليكم  أخي وصديقي السيوطي

اين أنت إفتقدناك لم ارى ردودك منذ فترة

ثانيا : أشكرك جزيل الشكر انت رجل الطيب تحب الخير لكل الناس ولا انسى لك هذه انت مدين لي

بارك الله فيك أنقذتني من مصيبة

[احمدزمان]

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

 

وبعد جهد جهيد

 

هذا آخر ما استطعت عمله

Dim FS As Worksheet, TS As Worksheet, RN1 As Range, RN2 As Range, RN3 As Range
Dim ER, R, C
Sub ãÇßÑæ1()
'
Application.Calculation = xlManual

Set FS = Sheets(ActiveSheet.Name)
Set TS = Sheets("Sheet2")
ER = FS.UsedRange.Rows.Count
    Range("I1") = "ÇáäæÚ"
    Range("J1") = " ÇÓã ÇáÚãíá"
    Range("K2").EntireColumn.Insert
    Range("K2:K" & ER).FormulaR1C1 = "=IF(RC9="""",R[-1]C11,RC9)"
    ActiveWorkbook.Names.Add Name:="ABCD", RefersTo:=FS.UsedRange
FS.Calculate
For R = 2 To ER
If Cells(R, 10) <> "" Then Cells(R, 9) = Cells(R, 11)
Next R
    Range("K2").EntireColumn.Delete
For C = 1 To FS.UsedRange.Columns.Count - 1
If FS.Cells(1, C) = "" Then FS.Cells(1, C) = C.Text
Next C
TS.Select
    TS.Columns("A:F").Delete
    TS.Range("A1").FormulaR1C1 = "=Sheet1!R1C10"
    TS.Range("A2").FormulaR1C1 = "<>" & "" '=CONCATENATE(""<>"",R1C1,""*"")"
    TS.Range("C1").FormulaR1C1 = "=Sheet1!R1C10"
    TS.Range("C2").FormulaR1C1 = "=CONCATENATE(""<>"",""*"",R1C3,""*"")"
    TS.Range("B2").FormulaR1C1 = "<>" & "" '=CONCATENATE(""<>"",R1C1,""*"")"
    TS.Range("A3").FormulaR1C1 = "=Sheet1!R1C10"
    TS.Range("B1").FormulaR1C1 = "=Sheet1!R1C9"
    TS.Range("B3").FormulaR1C1 = "=Sheet1!R1C9"
    TS.Range("C3") = "ÇáãÌãæÚ"
Set RN1 = FS.Columns("I:J") 'UsedRange
Set RN2 = TS.Range("A1:C2")
Set RN3 = TS.Range("A3:B55555")

RN1.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=RN2, CopyToRange:=RN3, Unique:=True
ER = TS.UsedRange.Rows.Count + 2
    TS.Range("A1:G2").Clear
    Range("C4:C11").FormulaR1C1 = _
        "=SUMPRODUCT((INDEX(ABCD,,10)=RC1)*(INDEX(ABCD,,9)=RC2),INDEX(ABCD,,1))"
'    Range("C4:C" & ER).FormulaR1C1 = _
        "=SUMPRODUCT((INDEX(ABCD,,10)=RC1)*(INDEX(ABCD,,9)=RC2))"
'    Range("D4:D" & ER).FormulaR1C1 = _
        "=SUMPRODUCT((INDEX(ABCD,,10)=RC1)*(INDEX(ABCD,,9)=RC2),INDEX(ABCD,,1))"
    TS.Range("A1:G2").Clear
    Range("C2").FormulaR1C1 = "=SUBTOTAL(9,R3C3:R55555C3)"
    Range("A3:D" & ER).Columns.AutoFit
    Range("A3:D" & ER).AutoFilter
ThisWorkbook.Save
TS.Calculate
'GoTo 9
'For Each RN In TS.UsedRange
'RN = RN
'Next

9
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub

سوف يتم عمل قائمة غير مكررة بها اسم كل عميل ومشترياته ومجمع امامها الكمية

مع التصفية التلقائية

حاولت اطبق دالة SUMPRODUCT على كامل الجدول بالكود الا ان امكانيات جهازي ضعيفة ويعلق الإكسل عندها

لذلك عملتها في 9 صفوف فقط - - - يمكنك نسخها الى آخر صف

==

من التصفية اختار اسم العميل يظهر لك كل مشترياته ومجموعها

اختار نوع اي منتج من التصفية - يظهر كل العملاء الذين اشترو هذا المنتج وكل الكميات وفي الأعلى اجمالي الكميات

==

آمل ان تستفيد منه في ما تريد

 

 

Copy of Report2.rar

[عطاء الله]

السلام عليكم أخي أحمد

بارك الله فيك أخي أحمد الزمان

بعد العسر يسر

[احمدزمان]

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

صدقت اخي عطاء الله

((ان مع العسر يسرا))

 

و

 

الصبر مفتاح الفرج