مساعدة تصحيح الاحصائية في كود ترحيل

[ضاحي الغريب]

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

الأخـوة الكرام

برجاء المساعدة في ظبط جزئية الاحصاء في كود ترحيل الاقامة حسب الصلاحية

حيث أن لايقوم بعد الاقامات المرحلة حسب الصلاحية مضبوط

الكود

Sub TARHEEL()

Dim R As Integer, A As Integer, B As Integer, C As Integer, D As Integer, E As Integer, F As Integer

Sheets("الأقامات السارية").Range("A5:K1000").ClearContents

Sheets("القامات المنتهية").Range("A5:K1000").ClearContents

A = 5: B = 5: C = 5: D = 5: E = 5: F = 5: G = 5: H = 5: I = 5: j = 5: K = 5

Application.ScreenUpdating = False

For R = 5 To 1000

'''''''''''''''''''''''''''''''''''''''''''''''''''

If Cells(R, 6) = " الإقامة سارية" Then

Range("A" & R).Resize(1, 11).Copy

Sheets("الأقامات السارية").Range("A" & A).PasteSpecial xlPasteValues

Application.CutCopyMode = False

A = A + 1

End If

''''''''''''''''''''''''''

If Cells(R, 6) = "الإقامة منتهية" Then

Range("A" & R).Resize(1, 11).Copy

Sheets("الأقامات المنتهية").Range("A" & B).PasteSpecial xlPasteValues

Application.CutCopyMode = False

B = B + 1

End If

Next


MsgBox ("الحمد لله تم ترحيل الأقامات حسب الصلاحية ")


		 For K = 1 To 2

			 Y = Sheets(K).[B3000].End(xlUp).Row - 4

			 mssg = mssg & Chr(10) & Format(Y, "00") & " إقامـة : " & K

		 Next K


		 MsgBox (" تـم ترحيل عدد" & mssg)


		 For j = 1 To 2

				 Sheets(j).[B5] = 1

				 rrw = Sheets(j).[B3000].End(xlUp).Row

				 For Each CC In Sheets(j).Range("B6:B" & rrw)

						 CC.Value = CC.Offset(-1, 0) + 1

				 Next CC



	 Next j


		 Sheets("DATA").Select

	 Range("B5").Select


Application.ScreenUpdating = True

End Sub

بالمرفقات الملف

Validity.rar

[بن علية حاجي]

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

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

أخوك بن علية

Validity.rar

[ضاحي الغريب]

اخي الكريم بن علية حاجي

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

سلمت يداك هذا هو المطلوب

جزاك الله كل خير ونفعك بعلمك وعملك

تقبل تحياتي

اخوك ضاحي الغريب

[ضاحي الغريب]

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

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

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

فبرجاء ضبط الجزء الخاص بعد المرحيليين

مرفق نموذج لملف العمل

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

22.rar

[بن علية حاجي]

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

أخي الكريم، المشكل يكمن في ترتيب الشيتات فيما بينها (من اليمين إلى اليسار أو العكس حسب الاتجاه المختار للمصنف) ففي الكود تم الإشارة إلى الشيتات بالرمز (Sheets(K أو (Sheets(j (حيث المتغير K يأخذ القيمتين 2 و 3 ويقصد بذلك الشيتين 2 و3 والمتغير j يأخذ القيم من 1 إلى 3 ويقصد بذلك الشيتات الثلاثة الأولى) أي برقم الترتيب للشيت وليس باسم الشيت وبما أن الشيتات المعنية في الكود بالترتيب (الأول فالأول) هي : "الصلاحية" ، "الأقامات المنتهية" ، "الأقامات السارية" فيجب ترتيبها وفي ملفك أدرجت قبلهما شيتين آخرين "البيانات" و "طباعة".... وفي الملف المرفق تم ترتيب كل الشيتات حسب ما يتطلبه الكود وعادت الأمور إلى طبيعتها...

أخوك بن علية

22.rar

[ضاحي الغريب]

أخي الكريم بن علية حاجي

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

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

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

في علمك وعملك ورزقك واولادك

تقبل تحياتي

اخيك ضاحي

[ضاحي الغريب]

أخي اكريم بن علية

هــل لي بسؤال......؟ واتمني تسامحني علي تعبك معايا

كيف يتم ترتيب الشيتات في الملف الاصلي بما يتناسب الكود

هل اقوم بتغير اسماء الاوراق

لكن اريد الترتيب التالي

من اليمين الي اليسار (( البيانات - طباعة - تقرير الصلاحية - السارية - المنتهية )

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

او ان هــل توجد طريقة اخري في الكود بتسمية الصفحات

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

[بن علية حاجي]

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

أخي الكريم، إذا أردت أن يكون ترتيب الشيتات بالشكل (البيانات - طباعة - تقرير الصلاحية - السارية - المنتهية ) من اليمين إلى اليسار فيجب تغيير قيم K و J في الكود، وفي هذه الحالة K يأخذ القيمتين 4 و 5 بدلا من 2 و 3 مع تبديل (Tab(K-1 بـ (Tab1(K-3 والمتغير J يأخذ القيم من 3 إلى 5 بدلا من 1 إلى 3...

لاحظ التغييرات التي وضعتها في الكود...

أخوك بن علية

22.rar

[ضاحي الغريب]

بارك الله لك

اخي بن علية

تم بحمد الله

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