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

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


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

الاخوه الافاضل

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

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

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

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

كود عمل تسلسل.rar

رابط هذا التعليق
شارك

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

تقبل الله منا ومنكم الصلاة والصيام والقيام وصالح الأعمال....

أخي الكريم هذا حل كبداية باستعمال المعادلات... في انتظار حلول أخرى من إخوتنا الكرام...

أخوك بن علية

تسلسل.rar

رابط هذا التعليق
شارك

الاخ بن علية

بارك الله فيك

تسلم ايدك

ولكن ماذا لو اردنا حينما تكون اى خليه موجوده فى العمود b فارغه

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

رابط هذا التعليق
شارك

الاخ دغيدى بارك الله فيك

وانا مازلت انتظر من خبراء المنتدى

كود يقوم بعمل ذلك إن شاء الله

تم تعديل بواسطه دغيدى
رابط هذا التعليق
شارك

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

تقبل الله منا ومنكم الصلاة والصيام والقيام وصالح العمال....

أخي الكريم، تم تحضير كود بسيط (تحويل المعادلة المقترحة في الملف السابق إلى كود) يقوم بالعملية المطلوبة... أرجو أن يكون مقبولا أو انتظر من الأعضاء الكرام الذين لهم باع كبير في VBA حتى يدلوا بما فضل الله عليكم من علم ويقدموا أكوادا أفضل من الذي وضعته في الملف المرفق...

أخوك بن علية

تسلسل2.rar

رابط هذا التعليق
شارك

السلام عليكم

بعد إذن الاستاذ بن عليه

هذا كود بحلقات التكرار


Sub Abu_Ahmed()

Dim cl As Range: T = 3

Set MyRng = Range("B3:B" & Range("B65000").End(xlUp).Row)

Set MyRng1 = Range("A3:A" & Range("B65000").End(xlUp).Row)

MyRng1.Value = ""

For Each cl In MyRng

X = Application.CountIf(Range("B3:B" & T), cl)

If X = 1 Then cl.Offset(0, -1) = Application.Max(MyRng1) + 1

If X > 1 Then

For Each cll In MyRng

If cll = cl Then cl.Offset(0, -1) = cll.Offset(0, -1): Exit For

Next

End If

T = T + 1

Next

Set MyRng = Nothing: Set MyRng1 = Nothing

End Sub

رابط هذا التعليق
شارك

الاخوه الافاضل

الاخ بن علية

الاخ عبدالله

بارك الله فيكم

ولكن عندى استفسار فى كود الاخ بن عليه

حول معنى

If Cells(I, 2) <> "" Then

رابط هذا التعليق
شارك

ولكن عندى استفسار فى كود الاخ بن عليه

حول معنى

If Cells(I, 2) <> "" Then

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

رابط هذا التعليق
شارك

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

ايضا كود اخر بحلقات تكرارية


Sub AL_KHALEDI()

A = "A"	 'عمود التسلسل

B = "B"	 'عمود البيانات

R = 3	 'البيانات تبدأ من الصف

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

L = Range(B & 65000).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

رابط هذا التعليق
شارك


Private Sub Worksheet_Selectionchange(ByVal Target As Range)

A = "A" 'عمود التسلسل

B = "B" 'عمود البيانات

R = 3 'البيانات تبدأ من الصف

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

L = Range(B & 65000).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


===============================================

أحى الفاضل / إبراهيم ابوليله

ضع هذا الكود فى حدث الورقة المختارة

يعمل بدون زر

رابط هذا التعليق
شارك

اخى الفاضل بعد اذن اساتذتى خبراء الاكسيل تفضل هذا الملف لعله هو المطلوب وهو بدالة IF وليس بكود وشكرا

تسلسل تلقائى.rar

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

الاخ عبد الله

الاخ الخالدى

الاخ دغيدى

الاخ بن علية

مشكورين على ردوودكم

ولكن لى طلب بسيط انشاء الله

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

ان يكون من الخليه A4 الى الخليه A20 فقط

بحيث اننى حينما اكتب اى رقم ابتداء من الخليه B21 وما بعدها

لا يعطينى تسلسل فى الخليه A21 وما بعدها

وذلك لاننا سنكون حددنا فى الكود نطاق لعمل التسلسل وهو من A4 الى A20

تم تعديل بواسطه إبراهيم ابوليله
رابط هذا التعليق
شارك

الاخ بن علية

الاخ عبد الله

الاخ الخالدى

الاخ دغيدى

بارك الله فيكم

وكن لى طلب بسيط انشاء الله

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

بمعنى ان يظهر التسلسل فى الخلايا من A4 الى A20 فقط

رابط هذا التعليق
شارك

السلام عليكم

بعد إذن الاستاذ بن عليه

هذا كود بحلقات التكرار


Sub Abu_Ahmed()

Dim cl As Range: T = 3

Set MyRng = Range("B3:B" & Range("B65000").End(xlUp).Row)

Set MyRng1 = Range("A3:A" & Range("B65000").End(xlUp).Row)

MyRng1.Value = ""

For Each cl In MyRng

X = Application.CountIf(Range("B3:B" & T), cl)

If X = 1 Then cl.Offset(0, -1) = Application.Max(MyRng1) + 1

If X > 1 Then

For Each cll In MyRng

If cll = cl Then cl.Offset(0, -1) = cll.Offset(0, -1): Exit For

Next

End If

T = T + 1

Next

Set MyRng = Nothing: Set MyRng1 = Nothing

End Sub

مجهود رائع جزاك الله عليه خيراً كثيرا..

رابط هذا التعليق
شارك

السلام عليكم

جرب الكود في حدث الورقة


Private Sub Worksheet_Selectionchange(ByVal Target As Range)

Set Rn1 = [A4:A20]

Set Rn2 = Rn1.Offset(0, 1)

Rn1.ClearContents

For i = 1 To Rn1.Rows.Count

   If Rn1(i) = "" And Rn2(i) <> "" Then

	  N = N + 1

	  For ii = i To Rn1.Rows.Count

		 If Rn2(ii) = Rn2(i) Then Rn1(ii) = N

	  Next ii

   End If

Next i

Set Rn1 = Nothing: Set Rn2 = Nothing

End Sub

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

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.

×
×
  • اضف...

Important Information