اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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


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

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

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

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 test()

   [D6] = "CCR-" & Format(Application.WorksheetFunction.Substitute([B6], "CCR-", "") + 1, "000")

End Sub

أخوك بن علية

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

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

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

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

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

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

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

السلام عليكم

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

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

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


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

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

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



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

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

Important Information