تقرير شهري

[الشيباني1]

اخواني الاعزاء تحية طيبه كلفت باعداد تقرير شهري الى وكلاء الشركه كما في المرفق ارجو المساعده في ترحيل البيانات من الورقه 1 الى 2 بالمعادلات او كود مع الامتنان

تقرير شهري.zip

[طارق محمود]

في الورقة2

علام تدل أرقام الجداول

1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12 ؟؟؟

هل مثلا اذا كان المبلغ من 0 إلي 1000 يكون 1

واذا كان المبلغ من 1001 إلي 2000 يكون 2

وهكذا

[دغيدى]

أخى الفاضل / طارق

سلام الله عليكم

عفوا ..

الأرقام من 1 إلى 12 هى اشهر السنة حسب ما فهمت

[عبد الفتاح كيرة]

يمكن ساعات اليوم؟

-

عفوا كتبت هذا لتفعيل متابعة الموضوع

[الشيباني1]

اساتذتنا الكرام تحية طيبه الارقام المشار اليها تمثل اشهر السنه مع تقديري وشكري

[عبد الفتاح كيرة]

استخدمت التصفية المتقدمة

المرفقات

تقرير شهري kemas.rar

[الشيباني1]

استاذي العزيز حل رائع لكنه لا يوصلني للغاية المبتغاة اتمنى حلا" يمكن به طبع التقرير كما هو لارساله الى الوكلاء مع تقديري

[الشيباني1]

اخواني الاعزاء تحية طيبه هل انتظر ام اعتبر الموضوع منتهيا" عند هذا الحد ام اعيد صياغة الطلب بشكل آخر مع الشكر والامتنان لكل الجهود الخيره والعقول النيره

[طارق محمود]

السلام عليكم

تمهل ياأستاذ

تفضل الكود التالي تضعه في حدث الورقة الثانية

Private Sub Worksheet_Change(ByVal Target As Range)


If Target.Address <> "$H$3" Then Exit Sub

a = [H3]

Sheets(1).Range("$B$3:$E$105").AutoFilter Field:=4, Criteria1:=a


Dim ra As Range

Range("T10:W1000").ClearContents


Set ra = Sheets(1).Range("E3:E1000")

For Each nm In ra

	If nm.Value = a Then

    	tarikh = nm.Offset(0, -3).Value

    	qaema = nm.Offset(0, -2).Value

    	mablagh = nm.Offset(0, -1).Value

    	ii = ii + 1

    	Range("T" & ii + 10) = tarikh

    	Range("U" & ii + 10) = qaema

    	Range("V" & ii + 10) = mablagh

	End If

Next nm

'[T10].PasteSpecial Paste:=xlPasteValues



	Range("B9:R18,B24:R33,B39:R48,B54:R63").ClearContents


b = [T10000].End(xlUp).Row

	For r = 11 To b

    	m = Month(Range("T" & r))

    	x = Int((m - 1) / 3)

    	y = Int(3 * ((m - 1) / 3 - x) + 0.001)

    	Select Case y

        	Case 1

            	m_col = 8

        	Case 2

            	m_col = 14

        	Case 0

            	m_col = 2

    	End Select


    	m_row = x * 15 + 19


    	new_r = Cells(m_row, m_col).End(xlUp).Row + 1


 		Cells(new_r, m_col) = Cells(r, 20)

 		Cells(new_r, m_col + 2) = Cells(r, 21)

 		Cells(new_r, m_col + 4) = Cells(r, 22)


	Next r


   Range("T10:W" & b).ClearContents



End Sub

أو تفضل المرفق

تقرير شهري_Tareq.rar

[الشيباني1]

استاذنا الكبير تحية واحترام اعتذر اولا" على الالحاح وعدم التريث واشكرك جدا" ثانيا" على هذا الابداع الذي ادمنا عليه في هذا المنتدى الرائع وعلى هؤلاء الرجال الرجال ادامكم الرحمن لنا منقذا وجزاكم كل خير