مشكلة الترقيم التسلسي في خلايا مدمجة غير متناسقة

[ميلان]

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

 

السجل الكامل والصحيح للمخيم-DESKTOP-U85F05K.rar

[عبدالفتاح في بي اكسيل]

جرب هذا  الماكرو وجب  عليك تحديد  المدى  في  العمود A  الذي  تحتاج لترقيمه  

Sub autonumber_MergedCells()
  Dim serial  As Range, autonumber As Long
  Set serial = Selection(1)
  autonumber = 1
  Do While Not Intersect(serial, Selection) Is Nothing
    serial.Value = autonumber
    autonumber = autonumber + 1
    Set serial = serial.MergeArea.Offset(1)
  Loop
End Sub

 

تم تعديل أكتوبر 11, 2020 بواسطه عبدالفتاح في بي اكسيل

[سليم حاصبيا]

لا ضرورة لرفع ملف فيه الوف الصفوف و تنسيقات مزركشة مما يزيد حجم الملف الى أكثر من واحد ميغا

  لأن الماكرو الذي يعمل على صف واحد يمكنه العمل على الألوف من الصفوف

جرب ان تفعل في الورفة كما في الصورة المرفقة
 1- تغيير اسمها الى اي شيئ شرط باللغة الاجنبية (لحسن نسخ الماكرو ولصقه) انا اسميتها    Salim
 2- اضافة صفين فارغين  نماماً (اركز على كلمة فارغين تماماً) الصف رقم 2 والصف رقم 4
        (هذه الصفوف مخفية للمنظر من حهة ولعدم كتابة اي شيء فيها عن طريق الحطأ من جهة اخرى)
       بحيث تيدأ البيانات من الصف الخامس   الصف رقم3 عناوبن      (وذلك لفصل البياتات المتغيرة غن الثابتة)

3- نفذ هذا الماكرو

Sub Serial_number()
Dim Rg_A As Range
Dim Lra#, k%, i%
k = 1
With Sheets("Salim")
 Set Rg_A = .Range("A5").CurrentRegion.Columns(1)
 Rg_A.ClearContents
 Lra = Rg_A.Rows.Count - 1
   For i = 5 To Lra
    .Cells(i, 1) = k
    k = k + 1
    i = i - 1 + .Cells(i, 1).MergeArea.Rows.Count
   Next

End With
End Sub

 

 

mh_syr.xlsm

[ميلان]

استاذنا الكبير @سليم حاصبيا كل الشكر والتقدير والاحترام لك المنقذ الأول بعد الله سبحانه في كل المشاكل انا آسف معك الحق وأفعل في المره التاليه وشكرا لحلولك الرائعة ❤️

انا هنا اخي الكريم ولا أستطيع ان انسى استاذنا من الفضل والشكر ولو كان اكثر لفعلت تحياتي لك ❤️

شكرا اخي الكريم كل المحبه والاحترام والتقدير 💓