ارجو المساعده فى التعديل على كود تسلسل

[إبراهيم ابوليله]

الاخوه الكرام هذا كود

يقوم بعمل تسلسل للارقام فى العمود الاول

ولكنى الاحظ انه عندما اقوم بكتابه اى شء فى العمود

الثانى يتم كتابه الرقم فى العمود الاول

وعند مسح الرقم من العمود الثانى يظل الرقم فى العمود الاول كما هو

وبذلك فانا اريد انه طالما الخليه فى العمود الثانى ليس بها شئ

فيكون بالتالى الخليه المقابله لها فى العمود الاول فارغه

تسلس.rar

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

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

تقبل الله صلاة وصيام وقيام الجميع بالمزيد من الأجر والثواب...

أخي الكريم يمكنك إضافة أمر مسح محتويات العمود الأول قبل تنفيذ الكود... مثلا : ضف السطر التالي في الكود قبل سطر الـ IF الأولى :

Range("A6:A65000") = Empty

فيكون الكود في النهاية كما يلي:

Private Sub Worksheet_Selectionchange(ByVal Target As Range)


A = "A"  'ÚãæÏ ÇáÊÓáÓá

B = "B"  'ÚãæÏ ÇáÈíÇäÇÊ

R = 6   'ÇáÈíÇäÇÊ ÊÈÏà ãä ÇáÕÝ

'=================================================

Range("A6:A65000") = Empty

L = Range("B65000").End(xlUp).Row

If L < R Then Exit Sub

Range(Cells(R, A), Cells(L, A)).ClearContents

'=================================================

For I = R To L

If Cells(I, A) = "" And Cells(I, B) <> "" Then

		 N = N + 1

		 For ii = I To L

				 If Cells(ii, B) = Cells(I, B) Then

				 Cells(ii, A) = N

				 End If

		 Next ii

End If

Next I

End Sub

أخوك ين علية

[إبراهيم ابوليله]

اخى الكريم

بن علية

بارك الله فيك

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

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

أخي الكريم، أمر المسح كان موجودا أصلا في الكود ولكنه متعلق بالعمود B وبالتالي يكون الكود بعد التعديل عليه كما يلي:

Private Sub Worksheet_Selectionchange(ByVal Target As Range)


A = "A"  'ÚãæÏ ÇáÊÓáÓá

B = "B"  'ÚãæÏ ÇáÈíÇäÇÊ

R = 6   'ÇáÈíÇäÇÊ ÊÈÏà ãä ÇáÕÝ

'=================================================

L = Range(B & 65000).End(xlUp).Row

If L < R Then Exit Sub

Range(Cells(R, A), Cells(Range(A & 65000).End(xlUp).Row, A)).ClearContents

'=================================================

For I = R To L

If Cells(I, A) = "" And Cells(I, B) <> "" Then

		 N = N + 1

		 For ii = I To L

				 If Cells(ii, B) = Cells(I, B) Then

				 Cells(ii, A) = N

				 End If

		 Next ii

End If

Next I

End Sub

أخوك ين علية

[عبدالله المجرب]

بارك الله فيك استاذ بن عليه على هذا الجهد الكريم

وكل سنة وانت طيب