كود لعمل مسلسل في اي ملف

[رشا يوسف]

 السلام عليكم

واجهت صعوبه في حل هذا الكود ارجو المساعده

السؤال موضح  ع بنات اغسطس 555.rar داخل الملف المرفق 

تم تعديل أغسطس 26, 2015 بواسطه رشا يوسف

[ياسر خليل أبو البراء]

الطلب غير مفهوم ..يرجى التوضيح حتى نبتعد عن التخمين قدر الإمكان

ماذا تريدين من الكود ..هل المقصود عملية ترقيم للعمود الأول ؟؟

[خالد الرشيدى]

الاخت الفاضلة

صحيح انك قد وضحتى المطلوب تماما ولكن لم تذكرى حدث تنفيذ الكود .. اى .. كيف ينفذ الكود .. من خلال زر امر ام عند تنشيط الصفحة

الكود المستخدم فى الترتيب استناداً الى عدم فراغ خلايا العمود C وينفذ عند تنشيط الصفحة

عموماً اليكى الملف التالى وابدى ملاحظاتك

 ع بنات اغسطس 555_3.rar

[ياسر خليل أبو البراء]

بالنسبة للطلب الأول جربي الكود التالي

Sub SequenceAllSheets()
    Dim SH As Worksheet, LR As Long
    For Each SH In Worksheets
        With SH
            LR = .Cells(Rows.Count, "C").End(xlUp).Row
            If .Cells(LR, "C") = "جمـــلة " Then LR = LR - 1
            With .Range("A4:A" & LR)
                .NumberFormat = "General"
                .Formula = "=ROW()-3": .Value = .Value
            End With
        End With
    Next SH
End Sub

الطلب الثاني يخصص له موضوع مستقل

[رشا يوسف]

الله يباركم ادخلتم السرور الى قلبى ربنا يوفقكم 

الكورد يعمل بشكل جيد ولكن اريد ان يعمل فى ملف انا اختاره وليس فى كل الملفات وينتهى الترقيم فى المف الذى اختاره عندما تكون الخلية تحتوى على 0.00 بمعنى يبدأ الترقيم 1 ، 2 الى الخلية التى تحتوى على 0.00  

انا بعمل فى ملفات لعمل مرتبات المدرسين  ورقة العمل يكون فيها 5 ملفات الملف الاول يوجد به 15 مدرس والملف الثانى به 20 مدرس وهكذا 

المطلوب عمل مسلسل يبدأ بــــ 1  وينتهى  بالخلية التى تحتوى على 0.00    

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

[خالد الرشيدى]

لا يوجد مرفق

ومع ذلك يمكنك استخدام الكود التالى حيث يبدأ الترقيم من A4   (يمكنك تغييرها ) الى الخلية التى بها 0.00

 Dim k, i As Long, n As Long
  بالخلية المطلوبة  A4  اذا اردت تغيير خلية بداية التسلسل فقط استبدلى 
    With Range("A4:A" & Range("A" & Rows.Count).End(xlUp).Row)
        k = .Value
        For i = 1 To UBound(k, 1)
            If Len(k(i, 1)) = 0 Then
                n = n + 1
                k(i, 1) = n
            End If
        Next
        .Value = k
    End With

 

[رشا يوسف]

لكم جزيل الشكر \

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

ولكم جزيل الشكر 

llllllllllllllll - Copy.rar

[خالد الرشيدى]

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

  llllllllllllllll - Copy.rar

 

تم تعديل أغسطس 28, 2015 بواسطه خالد الرشيدى

[رشا يوسف]

رينا يوفقكم لمساعدة امثالنا دعواتنا لكم بالتوفيق 

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

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

ارجوالمساعدة فى ايجاد كود يعمل فى الملف الذى افتحة وينتهى المسلسل 0.00  سواء خلايا العمود فارغة

Sub SequenceAllSheets()ر
    Dim SH As Worksheet, LR As Longع
    For Each SH In Worksheets
        With SH
            LR = .Cells(Rows.Count, "C").End(xlUp).R
            If .Cells(LR, "C") = "جمـــلة " Then LR = LR - 1
            With .Range("A4:A" & LR)
                .NumberFormat = "General"
                .Formula = "=ROW()-3": .Value = .Value
            End With
        End With
    Next SH
End Sub

[خالد الرشيدى]

السلام عليكم

هذا الكود فى البداية كان للترقيم استناداً الى عدم فراغ عمود اخر ...  لعل ذلك لفهمى الخاطئ للمطلوب  ... ثم عدم وجود مرفق ووضع الكود دون فهم المطلوب ..

عموماً يمكنك استخدام الكود التالى

Sub ãÓáÓá()
  With Range("A4:A" & Range("A" & Rows.Count).End(xlUp).Row).Offset(-1)
        .Formula = "=ROW()-3": .Value = .Value
  End With
End Sub

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

Worksheet_Activate()

 

تم تعديل أغسطس 28, 2015 بواسطه خالد الرشيدى

[رشا يوسف]

لا استطيع ان اعبر عن سعادتى بنا يوفقكم  يا الله على هذا النبوغ والعبقرية 

شكرا من اعماق قلبى الف شكر 

 

[رشا يوسف]

السلام عليكم ورحمة الله وبركاته \  طبعا انا جربت الكود ولكن عندى ملاحظتين على هذا الكود اولا يمسح الخلية التى بها المسلسل ويجعهلها = صفر 

ثانيا ينتهى المسلسل 0.00  واذا كان فى العمود اكثر من 0.00 ورا بعض يعنى 3 خلايا بها 0.00  لانى استخدمها كميزان لعملية الجمع الافقى والرأسى فهى مهمة 

فيقوم الكود بمسح 2 من0.00  ويبقى الاخيرة 0.00 وبعديها فراغ

فهل يمكن عمل الكود لا يمسح المسلسل وننتهى 0.00  حتى اذا كان بعديها اى رقم  لكن ينتهى 0.00  وشكرالكم 

شرح المطلوب داخل الملف

جاويش يوليو.rar

تم تعديل أغسطس 29, 2015 بواسطه رشا يوسف
بعض الملاحظا

[ياسر خليل أبو البراء]

ماذا بعد لكن ؟؟

ربما يكون هناك خطأ ... ربما يكون الكود لم يطبق بشكل جيد ... ننتظر بعد ولكن ..

ويرجى إرفاق شكل النتائج المتوقعة حتى لا يطول الموضوع بدون داعي

[رشا يوسف]

ماذا بعد لكن ؟؟

ربما يكون هناك خطأ ... ربما يكون الكود لم يطبق بشكل جيد ... ننتظر بعد ولكن ..

ويرجى إرفاق شكل النتائج المتوقعة حتى لا يطول الموضوع بدون داعي

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

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

 الكود  والملف الثانى  لم اطبق فيه الكود لكى تعرفوا الفرق  . 

[خالد الرشيدى]

الاخت الكريمة

جاء رد استاذى ابو البراء قبل التعديل على مشاركتك التى كانت  متوقفه عند ولكن 

عموماً

جربى المرفق علة المطلوب

 جاويش يوليو.rar

تم تعديل أغسطس 30, 2015 بواسطه خالد الرشيدى

[علي رعد]

شكرا

[رشا يوسف]

ما هذا النبوغ وما هذه العبقرية  

ربنا يكتر  من امثالكم لهذا الوطن ويجعلكم  نبراسا لنا 

الف شكرا لكم الف الف شكر  لا استطيع ان اعبر عن سعادتى  لوجود فى مصر امثالكم  نستطيع ان نلمس العون والمساعدة منهم