logo

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
noureddine70 لا تميز خلال هذه الفترة-- لا تميز خلال هذه الفترة YasserKhalil برنامج فك حماية محرر الأكواد VBA وحماية unviewable اكسيل اسئله واجابات



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




موضوع مغلق


  • تمت الإجابة
subject icon تمت الإجابة ترقيم تلقائى
06-11-2020 01:12 مساءً
معلومات الكاتب ▼
تاريخ الإنضمام : 21-10-2019
رقم العضوية : 15301
المشاركات : 89
الجنس :
تاريخ الميلاد : 5-2-1973
قوة السمعة : 112
الاعجاب : 2
السلام عليكم الاستاذة الكرام اريد عمل ترقيم تلقائى سواء بالمعادلات او vba
الترقيم منقسم الى قسمين قسم ترقيم للجدول نفسه ومن ترقيم داخل الجدول نفسة الصراحة صعب الشرح بالكلام مرفق لحضرتكم الملف اعتقد انها فكرة جديدة لم يتم تناولها من قبل والله اعلم ترقيم.xlsm ترقيم.xlsm
 
 
  ترقيم.xlsm   تحميل xlsm مرات التحميل :(13)
الحجم :(9.471) KB





look/images/icons/i1.gif ترقيم تلقائى
  07-11-2020 09:56 صباحاً   [1]
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10525
الجنس :
تاريخ الميلاد : 1-10-1978
الدعوات : 24
قوة السمعة : 36745
الاعجاب : 182
وعليكم السلام أخي الكريم أحمد
جرب الكود التالي عله يفي بالغرض ..
الكود الأول يقوم بمسح البيانات الموجودة في العمود الأول في كل جدول مع مسح رقم الجدول ..
الكود الثاني يقوم بالترقيم بشكل تسلسلي لكل جدول ويكمل في الجدول الذي يليه ، مع فرض أن عدد صفوف كل جدول ثابتة (6 صفوف)
CODE
Sub Clear_Data_From_Tables()
    Dim r As Range, c As Range, rFirst As Range
    Set r = ActiveWorkbook.Worksheets("Sheet1").Range("A1:J100")
    Set c = r.Find("s", , , , xlByColumns)
    If rFirst Is Nothing Then Set rFirst = c
    Do While Not c Is Nothing
        c.Offset(1).Resize(6).ClearContents
        c.Offset(, 1).ClearContents
        Set c = r.FindNext(After:=c)
        If c.Address = rFirst.Address Then Exit Do
    Loop
End Sub

Sub Put_Sequence_To_Multiple_Tables_FindNext_Do_While_Loop()
    Dim w, r As Range, c As Range, rFirst As Range, m As Long, n As Long
    Set r = ActiveWorkbook.Worksheets("Sheet1").Range("A1:J100")
    m = 1: n = 1
    Set c = r.Find("s", , , , xlByColumns)
    If rFirst Is Nothing Then Set rFirst = c
    Do While Not c Is Nothing
        w = Evaluate("ROW(" & m & ":" & m + 5 & ")")
        c.Offset(1).Resize(UBound(w, 1)).Value = w
        c.Offset(, 1).Value = n
        m = m + 6: n = n + 1
        Set c = r.FindNext(After:=c)
        If c.Address = rFirst.Address Then Exit Do
    Loop
End Sub

أثارت هذه المشاركة إعجاب: احمد شريف، ابو طيبه، صلاح الصغير،



look/images/icons/i1.gif ترقيم تلقائى
  07-11-2020 01:47 مساءً   [2]
معلومات الكاتب ▼
تاريخ الإنضمام : 21-10-2019
رقم العضوية : 15301
المشاركات : 89
الجنس :
تاريخ الميلاد : 5-2-1973
قوة السمعة : 112
الاعجاب : 2
بسم الله ما شاء الله الله اكبر حضرتك رهيب فعلا مهما اقول مش هقدر اوفى قدر حضرتك انا قدرت احل النصف الاول هو ترقيم الجدول ولكن ليس بهذا الابهار اللى حضرتك عملته اما الباقى فكان لى ضربا من المستحيل جزاك الله كل خير يا استاذ ياسر

أثارت هذه المشاركة إعجاب: YasserKhalil،



look/images/icons/i1.gif ترقيم تلقائى
  07-11-2020 02:01 مساءً   [3]
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10525
الجنس :
تاريخ الميلاد : 1-10-1978
الدعوات : 24
قوة السمعة : 36745
الاعجاب : 182
وجزيت خيراً أخي العزيز أحمد شريف ومشكور على كلماتك الطيبة
والحمد لله الذي بنعمته تتم الصالحات




look/images/icons/i1.gif ترقيم تلقائى
  07-11-2020 06:15 مساءً   [4]
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10525
الجنس :
تاريخ الميلاد : 1-10-1978
الدعوات : 24
قوة السمعة : 36745
الاعجاب : 182
تم نقل الموضوع لقسم إكسيل أسئلة وإجابات ... يرجى طرح السؤال في القسم المناسب






المواضيع المتشابهه
عنوان الموضوع الكاتب الردود الزوار آخر رد
كيفية علم ترقيم تسلسلي في PIVOT TABLE mmagedmemo
1 151 mmagedmemo
ترقيم تلقائى لإذن الصرف ashraf_hertlion
6 557 YasserKhalil
كود ترقيم vba لايعمل AMIN FAID
10 2526 YasserKhalil
ترقيم من رقم الى رقم صلاح الصغير
3 999 YasserKhalil
ترقيم كل أربعة صفوف محمد محمد حمودة
3 1000 YasserKhalil

الكلمات الدلالية
ترقيم ، تلقائى ،









اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.

الساعة الآن 06:01 AM