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

ترقيم حجرات الامتحان تلقائيا في الشيت


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

اخواني الاعزاء في المنتدى الغالي اوفيسنا و منتدى الاكسيل الممتع 

ياريت لو فيه معادلة او كود يقوم بعمل المطلوب في الملف المرفق 

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

ترقيم تلقائي.rar

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

السلام عليكم

اقتباس

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

هل تقصد اضافة عمود يقوم بعمل مسلسل حسب رقم الحجره ؟

واذا كان المقصد المسلسل في عمود رقم الحجره كيف اعرف هذا الاسم ينتمي لأي حجره !

 

جرب هذا الكود حسب فهمي لطلبك

Sub Ali_Num()
Dim Sw As Worksheet
Dim R, Rb, Rb_To, Vl, i
Set Sw = ورقة1
With ورقة18
For R = 5 To .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(R, 1) <> Empty Then
   Rb = Val(.Cells(R, 3))
   Rb_To = Val(.Cells(R, 4))
   Vl = Val(.Cells(R, 1))
 For i = Rb To Rb_To
   Sw.Cells(i + 1, "I") = Vl
 Next
End If
Next
End With
End Sub

 

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

أخي الحبيب أبو نصار

أعتقد أنه لا داعي لاستخدام الحلقات التكرارية المتداخلة حيث أن ذلك يبطيء من عمل الكود ...

جرب الكود بهذا الشكل ولاحظ الفرق في سرعة تنفيذ الكودين

Sub Ali_Num()
    Dim SW As Worksheet
    Dim R, Rb, Rb_To, Vl, i
    Set SW = ورقة1
    With ورقة18
        For R = 5 To .Cells(.Rows.Count, 1).End(xlUp).Row
            If .Cells(R, 1) <> Empty Then
                Rb = Val(.Cells(R, 3))
                Rb_To = Val(.Cells(R, 4))
                Vl = Val(.Cells(R, 1))
                SW.Cells(Rb + 1, "I").Resize(Rb_To - Rb + 1) = Vl
            End If
        Next
    End With
End Sub

 

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

الاستاذ / العيدروس ( ابو نصار ) جزيت الخير من رب العالمين  على اهتمامك بالرد

فلك مني كل الشكر والتحية 

استاذنا الاستاذ ياسر ( ابو البراء ) : ماشاء الله .. كود رائع يفي بالمطلوب تماما ..

جزاك الله خيرا .. وزادك علما ونشاطا لخدمة الاعضاء ..لك كل التحية والتقدير

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

ترقيم تلقائي.rar

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

Sub Ali_Num()
    Dim WS As Worksheet
    Dim R, RB, RB_To, Vl, I
    
    Set WS = ورقة1
    With ورقة18
        I = .Range("H4").Value
        For R = 5 To .Cells(.Rows.Count, 1).End(xlUp).Row
            If .Cells(R, 1) <> Empty Then
                RB = Val(.Cells(R, 3))
                RB_To = Val(.Cells(R, 4))
                Vl = Val(.Cells(R, 1))
                WS.Cells(RB - I + 2, "I").Resize(RB_To - RB + 1) = Vl
            End If
        Next
    End With
End Sub

أخي الكريم أحمد الحاوي

ليس من أبدع كمن عدل ..الكود يظل باسم معلمي أبو نصار

إليك التعديل البسيط ليؤدي الغرض

 

 

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

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

بعد اذن اساتذتى الاجلاء

الحل باستخدام المعادلات والاستعانة ببعض الاعمدة الاضافية

 

ترقيم تلقائي.rar

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

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