اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

قام بنشر

الاخوة الاساتذة الافاضل

كل عام وانتم بكل الخير

المنتدى جميعا الاساتذة والعمالقة

الاستاذ عبد الله المجرب ابو احمد شكر وتقدير واحترام خاص جدا

الاخوة بحاجة لعمل تقرير

اريد ان يتم عمل تقرير بالاتى

من ورقة الارتباطات صفحة هى اسماء اوراق العمل ب شيت الارتباطات

باق الصف هى الاشهر

اريد ان يتم الاعتماد على كلمة الاجمالى بشيت الارتباطات

الصف الملون ب اللون الرصاصى

حسب ترتيبه بشيت الارتباطات هو ترتيب الاشهر بورقة التقرير

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

يتم الاتى

لو كتبت الاجمالى يتم جمع خلية ب1+ب2+ب3+ب4

ويتم نقلها حسب اسم الصفحة 1او2 او3 الاشهر

بالترتيب بمعنى اول صف يكتب به الاجمالى يمثل شهر يوليو

وثانى صف يكتب به الاجمالى يمثل شهر اغسطس

وذلك لك صفحة

وشاكر لكم وكل عام وانتم بخير

تقرير.rar

  • الردود 57
  • Created
  • اخر رد

Top Posters In This Topic

قام بنشر (معدل)

استاذنا شكرى وتقدير وفائق احترامى

ولكن اخى

انا اريد ان اى سطر يتم كتابة كلمة الاجمالى فى الصفحة يكون هو اول شهر

ثم اى سطر يأتى بعده  يكون ثانى شهر واى سطر يكتب به الاجمالى يكون هو ثالث شهر

اى المعيار ترتيب كلمة الاجمالى فى الصفحة

بمعنى لو السطر 50 مثلا كتبت به الاجمالى فى خانة البيان مجموع ب1+ب2+ب3 يكون هو اول شهر لو مفيش اى سطر قبله به كلمة اجمالى

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

وايضا بعد اذنك عمود او2و3 هو اسماء الشيتات فى ملف الارتباطات فبعد اذنك اخى يكون هذا العمود تتغير طبقا لاسماء الشيتات بملف الارتباطات

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

تم تعديل بواسطه abouelhssan
  • 2 weeks later...
قام بنشر

السلام عليكم

أخي العزيز /أباالحسن

رفق الحل بالكود كما طلبت

بشرط ان يكون الملفين في نفس المجلد

وهذا هو الكود للمطالعة



Sub AbulHassan()

f1Name = ActiveWorkbook.Name

pth = ActiveWorkbook.Path

f2Name = "الارتباطات.xls"

file2 = pth & "\" & f2Name


'مسح البيانات القديمة

Range("B2:O4").ClearContents


On Error Resume Next


'الجزء التالي يفتح ملف الارتباطات إن لم يكن مفتوحا مع أخذ الإحتمال ان يكون ملف الارتباطات مفتوح بالفعل

Set F_check = Excel.Workbooks(f2Name)

If Err = 0 Then GoTo 10


Workbooks.Open Filename:=file2


10


'الذهاب لملف الارتباطات وتحديد وترحيل القيم التي توافق الإجمالي فقط

Workbooks(f2Name).Activate

For sh = 1 To Worksheets.Count

	For a = 5 To Sheets(sh).[b1000].End(xlUp).Row

		If Sheets(sh).Cells(a, 2) = "الاجمالى" Then

			m = Month(Sheets(sh).Cells(a, 1))

				' معرفة الإسم العربي للشهر

				Select Case m

					Case 1: mA = "يناير"

					Case 2: mA = "فبراير"

					Case 3: mA = "مارس"

					Case 4: mA = "أبريل"

					Case 5: mA = "مايو"

					Case 6: mA = "يونيو"

					Case 7: mA = "يوليو"

					Case 8: mA = "اغسطس"

					Case 9: mA = "سبتمبر"

					Case 10: mA = "اكتوبر"

					Case 11: mA = "نوفمبر"

					Case 12: mA = "ديسمبر"

				End Select

			s = WorksheetFunction.Sum(Sheets(sh).Range("E" & a & ":" & "H" & a))


			cc = WorksheetFunction.Match(mA, Workbooks(f1Name).Sheets(1).Range("1:1"), 0)

			rr = WorksheetFunction.Match(sh, Workbooks(f1Name).Sheets(1).Range("A:A"), 0)


			Workbooks(f1Name).Sheets(1).Cells(rr, cc) = s


		End If

	Next a

Next sh


'رسالة بالبيانات المرحلة


Workbooks(f1Name).Activate

[a1].Select

MsgBox ("تم الترحيل بنجاح")

End Sub


تقرير_2.rar

قام بنشر (معدل)

اخى استاذ طارق تسلم يمين

بس عندما نسخت اسماء الاوراق بملف الارتباطات تحت كلمة صفحة بالتقرير ووضعت الملفين معا

واخترت ترحيل لم يعمل شئ واتتنى رسالة ان الترحيل تم بنجاح والصفحة التقرير فاضية

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

واحترامى الشديد لشخصك الكريم

تم تعديل بواسطه abouelhssan
قام بنشر

استاذ طارق السلام عليكم

بعد ان اضفت اسماء اوراق الارتباطات وعددها40 شيت

تحت صفحة فى التقرير بدل من 1 2 3 واضغط ترحيل

لايحدث شئ ويأتينى رسالة اسنها تم الترحيل

ما الحل اخى

قام بنشر

هاقوللك علي حل سريع

إعمل نسخة من الملف

وفي النسخة

إما تعمل الآتي شيت بشيت (ورقة بورقة)

أو تعلم علي الشيتات كلها وتعمل الآتي

تترك فقط عشرة أو عشرين سطر بيانات ثم تظلل الأسطر كاملة من السطر الواحد والعشرون لآخر الشيت ثم تلغيها وتحفظ الملف (النسخة الجديدة)

ستجد الحجم نزل من 70 ميجا إلي ميجا واحدة علي الأكثر

قام بنشر

استاذنا

الاسماء بالتقرير تحت كلمة صفحة التى بالكود هى هى التى بالتقرير الى بالمعادلات

وتعمل بالمعادلات ولا نعمل بالكود

مش عارف ليه

احترامى الشديد

قام بنشر

السلام عليكم

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

وفي النسخة كما اتفقنا إعمل الآتي

شيت بشيت (ورقة بورقة)

قف علي الخلية J200 مثلا

ثم من عندها CTRL-SHIFT-END

ثم CTRL-SPACE

لتظلل كل ماوراء ذلك من صفوف بيانات

كليك يمين ، إحذف كل تلك السطور

كرر ذلك علي الشيتات كلها

إحفظ الملف الجديد

ستجد الحجم نزل إلي أقل من ميجا واحدة

جرب من فضلك

قام بنشر

السلام عليكم

جزاك الله خير استاذ طارق محمود على اكوادك الرائعة وسهله الفهم

جعلها الله في ميزان حسناتك

بعد اذن استاذنا الحبيب

استعن بهذا الكود كي يقوم بحذف السطور من a25:az5000

في جميع الاوراق


Sub cle_ali()

    Dim i As Integer

    On Error GoTo ali

    For i = ActiveWorkbook.Sheets.Count To 1 Step -1

    Application.ScreenUpdating = False

    ActiveWorkbook.Sheets(i).Range("a25:az5000").Clear

    Next i

ali:

   Application.ScreenUpdating = True

End Sub

بعدها سوي حفظ بأسم للملف وحطه في سطح المكتب ثم ارفقه بمشاركه

قام بنشر
السلام عليكم جزاك الله خير استاذ طارق محمود على اكوادك الرائعة وسهله الفهم جعلها الله في ميزان حسناتك بعد اذن استاذنا الحبيب استعن بهذا الكود كي يقوم بحذف السطور من a25:az5000 في جميع الاوراق
 Sub cle_ali() Dim i As Integer On Error GoTo ali For i = ActiveWorkbook.Sheets.Count To 1 Step -1 Application.ScreenUpdating = False ActiveWorkbook.Sheets(i).Range("a25:az5000").Clear Next i ali: Application.ScreenUpdating = True End Sub 

بعدها سوي حفظ بأسم للملف وحطه في سطح المكتب ثم ارفقه بمشاركه

شكر وتقدير وفائق الاحترام اخى

استاذ طارق حضرتك جرب تغير اسماء الشيات فى نفس الملف مع اضافة 39 شيت باسماء مثل مرتب واضافى وجرب ولن تأتى البيانات للتقرير

اسف جداااااا والله بحاجة للكود ولم استطيع رفع الملف

احترا من اخيك

قام بنشر

السلام عليكم

استاذ طارق حضرتك جرب تغير اسماء الشيات فى نفس الملف مع اضافة 39 شيت باسماء مثل مرتب واضافى وجرب ولن تأتى البيانات للتقرير

اسف جداااااا والله بحاجة للكود ولم استطيع رفع الملف

أخي الحبيب

بالفعل كان الكود يحتاج تعديل طفيف

وأيضا أسماء الشيتات في (الملف تقرير) لابد أن يكون بصيغة تيكست أو تضع قبله أبوستروف في حالة أن يكون إسم الشييت رقم (مثل 1،2،3..)

تفضل المرفقات ويوجد بملف الإرتباطات أكثر من 50 شييت

abuElhassan.rar

قام بنشر (معدل)

نعم نعم نعم هذا هو كود ولا فى الاحلام

يعمل 10000%

تسلم ايدك اخى استاذ طارق

والله احترامى الشديد

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

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

وكل الشكر لشخصك الكريم

دمتم اخوانى

وكل الاخوة الاساتذة سابقين بالخير

زخرا للمنتدى

اخيك بمنتهى الاحترام

تم تعديل بواسطه abouelhssan

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه



×
×
  • اضف...

Important Information