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

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

قام بنشر

تحياتي لجميع العلماء والمشرفين الاعزاء

لدي ملف إكسل يحتوي على مجموعة من الأكواد وهذه الأكواد تحتوي على أرقام تسلسلية وأحرف كما يلي

CCR-001

CCR-002

وهكذا ...

المطلوب هو أنه للحصول على الكود الجديد يجب إضافة رقم 1 للكود الحالي ( آخر كود تم استخدامه ) ولكن هنا الكود يحتوي على أحرف ضمن الأرقام

كيف يمكننا جمع رقم 1 للرقم المتسلسل المجاور للأحرف في الكود

مرفقا ملف يوضح ذلك

مع الاحترام والتقدير لجهود علمائنا الأعزاء

كود لجمع تسلسل أرقام تحتوي على أحرف ثابته.rar

قام بنشر

أخي الكريم أبي تميم

لعمل هذا التسلسل قم بالآتي:

ضع هذه المعادلة في الخلية التي بها أول مسلسل


="CCR-"&TEXT(ROW(A1),"000")

ثم قم بنسخ المعادلة لباقي الصفوف للحصول على التسلسل التالي

أتمنى أن يكون هذا هو المطلوب

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

أخي الاستاذ محمد صالح

جربت المعادلة ولكنها لم تعمل معي هل يمكن تطبيقها على الملف في المشاركة الأصلية

علما أني اريد النتيجة تظهر دائما في نفس الخلية وهي B6

أي أن النتيجة وهي الكود الجديد يجب أن يكتب تلقائيا في الخلية D6

ولك جزيل الشكر

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

أرفق أليكم الملف مرة أخرة مع بعض التعديل على الجدول

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

يظهر عندي في الخلية D6 الكود الجديد حسب المعادلة

كود لجمع تسلسل أرقام تحتوي على أحرف ثابته.rar

قام بنشر

تفضل أخي الكريم

ضع هذا الكود في موديول جديد

ثم قم بربطه بالزر الموجود في الشيت


Sub newcode()

Dim oldtstr As String, newstr As String

oldstr = Range("B6").End(xlDown).Value

newstr = Mid(oldstr, 5) + 1

ActiveSheet.Range("d6").Value = Mid(oldstr, 1, 4) & Format(newstr, "000")

End Sub

ولكن أعتقد أنه ينقص شيء وهو إضافة الكود الجديد لقائمة الأرقام الحالية في حالة ما إذا تم استعماله

  • Like 1
قام بنشر

شكرا للجميع على تعاونهم

في الحقيقة كود الأخ الاستاذ محمد صالح ممتاز جدا لأنه يعمل بشكل عام أي أنه في حال تم تغيير الأحرف فإنه يعمل على القائمة المحددة له فإنه يعمل عليها بشكل ممتاز جدا

جزاك الله خيرا أخي الاستاذ محمد صالح

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

انتهى السؤال وتمت الاجابة

قام بنشر

السلام عليكم

بعد اذن الاساتذة الكرام واثراءً للموضوع

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

يمتاز بانه لن يتاثر بعدد الاحرف (مرن)


Sub Abu_Ahmed()

LR = [b1000].End(xlUp)

[d6] = Mid(LR, 1, InStr(LR, "-")) & Format(Val(Mid(LR, InStr(LR, "-") + 1, 5)) + 1, "000")

End Sub

قام بنشر

ما شاء الله

نعم التعاون على البر والتقوى

ربنا يوفق الجميع للخير

في الدنيا والآخرة

قام بنشر

روعة يا علماء الاكسل

سلمت أناملكم الذهبية

فعلا كل كود أروع من الآخر وجميعها مذهلة جدا

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

قام بنشر

السلام عليكم

حقيقة أكواد قمة الروعة

وهكذا في حدث االصفحة


Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, [B6]) Is Nothing Then

			  ALI_C = Target.Value

			  If Len(ALI_C) > 0 Then

			  S = Mid(ALI_C, 1, 6)

			  Z = S & Z + 1 + Right(ALI_C, 2)

			  End If

			  Application.EnableEvents = False

			  Target.Offset(0, 2).Value = Z

			  Application.EnableEvents = True

End If

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.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information