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

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

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

السلام عليكم إخوتي الكرام في المنتدي العظيم

مرفق ملف ايجارات مول تجاري ، الفكره تتلخص في الاتي

هناك محلات تجارية تؤجر لمستاجرين بمبلغ معين لكل محل و فيه 5% من الايجار للصيانة و 2.5% منه للسعي و الدعاية غالبا ما تكون 1500 و لكنها ليست دائمة

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

في الورقه (البيانات) سجلت بيانات المحل مستندا علي رقم المحل و رقم المستاجر المسجل في ورقة كود المستأجرين

في ورقة (الاستحقاقات) اكتب رقم المحل فيتم استدعاء بياناته من ورقة البيانات و يسجل الاستحقاق للمحل الواحد مرة واحده بالعام

في ورقة التحصيل اسجل التحصيل مثل ما سبق الا ان استدعاء البيانات هنا سيكون فقط 3 اعمده من ورقة البيانات

في ورقة المعيار استخدمة معادلة sumif لكي احصل علي اجماليات المحلات و المستاجرين

و النتيجه كل شيئ علي مايرام و طبعا اعلم ان هناك افضل مما صنعت انا و اعني بذلك استخدام كود بدلا من المعادلة و حاولت لكن لم استطيع توسيع النطاق بالكود ليعطي اجمالي كل عمود ( مثل الايجار- الصيانة-السعي الخ)

المطلوب من حضراتكم أولا:استبدال المعادلة بكود يحقق الغرض

ثانيا تسريع الملف لانه بطيئ جدا

ثالثا عمل كشف حساب مفصل بالحركات الخاصة بالمحل في صفحة كشف الحساب باستخدام استعلام حسب رقم المحل و حسب رقم المستأجر مع أي اضافة تفيد الغرض

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

لم استطيع ارفاق الملف

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

شكرا اخي يحيي حسين علي التفاعل و لكن كيف استخدم رابط خارجي في ارفاق الملف

و لا أدري لماذا لاتستجيب علامة ارفاق ملف مع اني قللت حجم الملف لان اصبح اقل من 1000 كيلو بايت

تم تعديل بواسطه deebsagheer
  • 7 months later...
قام بنشر

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

كلمة المرور هي lwvhguvfdm ارجو الافاده عن بطئ البرنامج و اي اقتراحات جديده لتعم الفائده مع الشكر

قام بنشر

السلام عليكم

أخي العزيز

ارجو الافاده عن بطئ البرنامج و اي اقتراحات جديده لتعم الفائده

مرفق الملف وبه تطوير صغير في ورقة تسجيل الحركات

حيث قللت بحمد الله كثيرا من حجم الكود

وستلاحظ السرعة بهذه الورقة عما كانت عليه من قبل

تفضل

ملاحظة

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

يمكنك حذف الموضوع من المكان الآخر

إيجارات مول تجاري.rar

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

كود Change القديم


Private Sub Worksheet_Change(ByVal Target As Excel.Range)

'For dd = 0 To 5

If Target.Column = 1 Then

	Dim cel As Range, tblRange As Range, xx As Range


	Set tblRange = Sheets("ÇáÈíÇäÇÊ").Range("A1", "A2000")

'	Application.EnableEvents = False

	For Each cel In tblRange

If [A1] = 1 Then

    	If UCase(cel) = UCase(Target) Then

        	With Target(1, 2)

            	.Value = cel(1, 2).Value


            	'.NumberFormat = "#,##0.00_);[Red](#,##0.00)"

        	End With

        	With Target(1, 3)

            	.Value = cel(1, 3).Value


            	'.NumberFormat = "#,##0.00_);[Red](#,##0.00)"

        	End With

        	With Target(1, 4)

            	.Value = cel(1, 4).Value


            	'.NumberFormat = "#,##0.00_);[Red](#,##0.00)"

        	End With

        	With Target(1, 5)

            	.Value = cel(1, 5).Value


            	'.NumberFormat = "#,##0.00_);[Red](#,##0.00)"

        	End With

        	With Target(1, 6)

            	.Value = cel(1, 6).Value


            	'.NumberFormat = "#,##0.00_);[Red](#,##0.00)"

        	End With

     		With Target(1, 7)

            	.Value = cel(1, 7).Value


            	'.NumberFormat = "#,##0.00_);[Red](#,##0.00)"

        	End With

        	With Target(1, 8)

            	.Value = cel(1, 8).Value


            	'.NumberFormat = "#,##0.00_);[Red](#,##0.00)"

        	End With

        	With Target(1, 9)

            	.Value = cel(1, 9).Value


            	'.NumberFormat = "#,##0.00_);[Red](#,##0.00)"

        	End With

     		With Target(1, 10)

            	.Value = cel(1, 10).Value


            	'.NumberFormat = "#,##0.00_);[Red](#,##0.00)"

        	End With

        	With Target(1, 11)

            	.Value = cel(1, 11).Value


            	'.NumberFormat = "#,##0.00_);[Red](#,##0.00)"

        	End With


        	With Target(1, 12)

            	.Value = cel(1, 12).Value


            	'.NumberFormat = "#,##0.00_);[Red](#,##0.00)"

        	End With


        	Columns(Target(5, 6).Column).AutoFit

        	Columns(Target(5, 7).Column).AutoFit

        	Columns(Target(5, 8).Column).AutoFit


        	Exit For


    	End If


ElseIf [A1] = 2 Then

  If UCase(cel) = UCase(Target) Then

        	With Target(1, 2)

            	.Value = cel(1, 2).Value


            	'.NumberFormat = "#,##0.00_);[Red](#,##0.00)"

        	End With

        	With Target(1, 3)

            	.Value = cel(1, 3).Value


            	'.NumberFormat = "#,##0.00_);[Red](#,##0.00)"

        	End With

        	With Target(1, 4)

            	.Value = cel(1, 4).Value


            	'.NumberFormat = "#,##0.00_);[Red](#,##0.00)"

        	End With

        	With Target(1, 5)

            	.Value = cel(1, 5).Value


            	'.NumberFormat = "#,##0.00_);[Red](#,##0.00)"

        	End With



        	Columns(Target(5, 6).Column).AutoFit

        	Columns(Target(5, 7).Column).AutoFit

        	Columns(Target(5, 8).Column).AutoFit


        	Exit For

        	Exit For

    	End If

    	End If


	Next

End If



Application.EnableEvents = True


 If Range("A3").Value = "" Then

 ActiveSheet.Range("$A$4:$Q$50000").AutoFilter Field:=1

Else

 ActiveSheet.Range("$A$4:$Q$50000").AutoFilter Field:=1, Criteria1:=Range("A3")

End If

If Range("D3").Value = "" Then

 ActiveSheet.Range("$D$4:$Q$50000").AutoFilter Field:=4

Else

 ActiveSheet.Range("$D$4:$D$50000").AutoFilter Field:=4, Criteria1:=Range("D3")

End If


End Sub

كود Change الجديد

Private Sub Worksheet_Change(ByVal Target As Excel.Range)


If Target.Column = 1 Then

	Dim cel As Range, tblRange As Range


 	xx = Sheets("ÇáÈíÇäÇÊ").Range("A20000").End(xlUp).Row

	Set tblRange = Sheets("ÇáÈíÇäÇÊ").Range("A1", "A" & xx)

	Application.EnableEvents = False

	For Each cel In tblRange

	If [A1] = 1 Then

    	If UCase(cel) = UCase(Target) Then

        	For ii = 2 To 12

            	Target(1, ii).Value = cel(1, ii).Value

        	Next ii


        	Columns("F:H").EntireColumn.AutoFit


    	Exit For


    	End If


ElseIf [A1] = 2 Then

  If UCase(cel) = UCase(Target) Then

        	For ii = 2 To 5

            	Target(1, ii).Value = cel(1, ii).Value

        	Next ii


   		Columns("F:H").EntireColumn.AutoFit


        	Exit For

        	Exit For

    	End If

    	End If


	Next

End If



Application.EnableEvents = True


 If Range("A3").Value = "" Then

 ActiveSheet.Range("$A$4:$Q$50000").AutoFilter Field:=1

Else

 ActiveSheet.Range("$A$4:$Q$50000").AutoFilter Field:=1, Criteria1:=Range("A3")

End If

If Range("D3").Value = "" Then

 ActiveSheet.Range("$D$4:$Q$50000").AutoFilter Field:=4

Else

 ActiveSheet.Range("$D$4:$D$50000").AutoFilter Field:=4, Criteria1:=Range("D3")

End If


End Sub 

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

الاخ طارق

بعد التحيه

اشكرك علي تفاعلك معي و بالفعل اختصارك للحود اعطي نتيجه جيده لكن اذا استخدمت الخلية A3 & D3 في التصفيه بالورقه تسجيل الحركات كان الكود بطيئا جدا و اعتقد ان كود التصفيه هو السبب لأنني قبل اضافة هذا الكود كان العمل سريعا الي حد ما

ارجو الافاده و لك جزيل الشكر

كذلك اذا عملت استحقاق في هذه الورقه و اردت ان الغيه يحدث توقف للكود الا اذا الغيته بعد اختيار تقارير لذا فهو يحتاج مع جملة if في استحقاق او تحصيل جملة Else

ارجو ان اكون قد اوضحت

وشكرا

قام بنشر

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

لعل المانع خيرا ، اتمني لك التوفيق

و أشكرك علي أي حال و أدعو الاخوه الافاضل للمشاركة

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