ابو تميم قام بنشر مارس 1, 2012 مشاركة قام بنشر مارس 1, 2012 تحياتي لجميع العلماء والمشرفين الاعزاء لدي ملف إكسل يحتوي على مجموعة من الأكواد وهذه الأكواد تحتوي على أرقام تسلسلية وأحرف كما يلي CCR-001 CCR-002 وهكذا ... المطلوب هو أنه للحصول على الكود الجديد يجب إضافة رقم 1 للكود الحالي ( آخر كود تم استخدامه ) ولكن هنا الكود يحتوي على أحرف ضمن الأرقام كيف يمكننا جمع رقم 1 للرقم المتسلسل المجاور للأحرف في الكود مرفقا ملف يوضح ذلك مع الاحترام والتقدير لجهود علمائنا الأعزاء كود لجمع تسلسل أرقام تحتوي على أحرف ثابته.rar رابط هذا التعليق شارك More sharing options...
أ / محمد صالح قام بنشر مارس 1, 2012 مشاركة قام بنشر مارس 1, 2012 أخي الكريم أبي تميم لعمل هذا التسلسل قم بالآتي: ضع هذه المعادلة في الخلية التي بها أول مسلسل ="CCR-"&TEXT(ROW(A1),"000") ثم قم بنسخ المعادلة لباقي الصفوف للحصول على التسلسل التالي أتمنى أن يكون هذا هو المطلوب 1 رابط هذا التعليق شارك More sharing options...
ابو تميم قام بنشر مارس 1, 2012 الكاتب مشاركة قام بنشر مارس 1, 2012 (معدل) أخي الاستاذ محمد صالح جربت المعادلة ولكنها لم تعمل معي هل يمكن تطبيقها على الملف في المشاركة الأصلية علما أني اريد النتيجة تظهر دائما في نفس الخلية وهي B6 أي أن النتيجة وهي الكود الجديد يجب أن يكتب تلقائيا في الخلية D6 ولك جزيل الشكر تم تعديل مارس 1, 2012 بواسطه ابو تميم رابط هذا التعليق شارك More sharing options...
ابو تميم قام بنشر مارس 1, 2012 الكاتب مشاركة قام بنشر مارس 1, 2012 أرفق أليكم الملف مرة أخرة مع بعض التعديل على الجدول الجدول يحتوي على مجموعة متسلسلة من الأرقام والمطلوب هو عند الضغط على كود جديد يظهر عندي في الخلية D6 الكود الجديد حسب المعادلة كود لجمع تسلسل أرقام تحتوي على أحرف ثابته.rar رابط هذا التعليق شارك More sharing options...
أ / محمد صالح قام بنشر مارس 1, 2012 مشاركة قام بنشر مارس 1, 2012 تفضل أخي الكريم ضع هذا الكود في موديول جديد ثم قم بربطه بالزر الموجود في الشيت 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 ولكن أعتقد أنه ينقص شيء وهو إضافة الكود الجديد لقائمة الأرقام الحالية في حالة ما إذا تم استعماله 1 رابط هذا التعليق شارك More sharing options...
بن علية حاجي قام بنشر مارس 1, 2012 مشاركة قام بنشر مارس 1, 2012 السلام عليكم ورحمة الله أخي الكريم، حسب الطلب جرّب الكود التالي: Sub test() [D6] = "CCR-" & Format(Application.WorksheetFunction.Substitute([B6], "CCR-", "") + 1, "000") End Sub أخوك بن علية رابط هذا التعليق شارك More sharing options...
ابو تميم قام بنشر مارس 1, 2012 الكاتب مشاركة قام بنشر مارس 1, 2012 شكرا للجميع على تعاونهم في الحقيقة كود الأخ الاستاذ محمد صالح ممتاز جدا لأنه يعمل بشكل عام أي أنه في حال تم تغيير الأحرف فإنه يعمل على القائمة المحددة له فإنه يعمل عليها بشكل ممتاز جدا جزاك الله خيرا أخي الاستاذ محمد صالح جزاكم الله خيرا الأساتذة الذين ساعدوا في الاجابة لكم كل الاحترام والتقدير انتهى السؤال وتمت الاجابة رابط هذا التعليق شارك More sharing options...
رجب جاويش قام بنشر مارس 1, 2012 مشاركة قام بنشر مارس 1, 2012 السلام عليكم هذا حل آخر عن طريق معادلة تعمل نفس عمل كود الأستاذ محمد صالح حتى فى حالة تغيير أحرف الكود حل اخر.rar رابط هذا التعليق شارك More sharing options...
عبدالله المجرب قام بنشر مارس 2, 2012 مشاركة قام بنشر مارس 2, 2012 السلام عليكم بعد اذن الاساتذة الكرام واثراءً للموضوع هذا الكود يقوم بنفس عمل اكواد ومعادلات الاخوة الكرام في الحلول السابقة لكن يمتاز بانه لن يتاثر بعدد الاحرف (مرن) 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 رابط هذا التعليق شارك More sharing options...
أ / محمد صالح قام بنشر مارس 2, 2012 مشاركة قام بنشر مارس 2, 2012 ما شاء الله نعم التعاون على البر والتقوى ربنا يوفق الجميع للخير في الدنيا والآخرة رابط هذا التعليق شارك More sharing options...
ابو تميم قام بنشر مارس 2, 2012 الكاتب مشاركة قام بنشر مارس 2, 2012 روعة يا علماء الاكسل سلمت أناملكم الذهبية فعلا كل كود أروع من الآخر وجميعها مذهلة جدا جزاكم الله كل الخير رابط هذا التعليق شارك More sharing options...
الـعيدروس قام بنشر مارس 2, 2012 مشاركة قام بنشر مارس 2, 2012 السلام عليكم حقيقة أكواد قمة الروعة وهكذا في حدث االصفحة 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 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان