عداد دوري تصاعدي تنازلي

[يترومس]

السلام عليكم

أبي أعمل عداد يعد من 0 حتى 1500 تصاعدي و لما يصل لعند 1500 يرجع يعد تنازلي لما يصل صفر و بعدها يرجع يعد تصاعدي و هكذا فهل يمكن ذلك من خلال الإكسيل أول دوال vba

أرجو المساعدة

[محمد حجازي]

السلام عليكم ...

جرب الكود التالي :

Sub MyNumbers()
    Dim MyRange As Range
    Dim i As Integer
    Set MyRange = Application.InputBox(prompt:="أدخل مجال الخلايا التي تريد إدراج الترقيم التلقائي فيها", Title:="مجال الخلايا", Type:=8)
    m = 1
    For Each MyCell In MyRange
        i = i + m
        MyCell.Value = i
        If i = 1500 Then m = -1
        If i = 0 Then m = 1
    Next MyCell
End Sub

[يترومس]

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

أشكرك جزيل الشكر أخ محمد حجازي بارك الله فيك و زادك من علمه . نعم هذا ما أريده بالضبط

[يترومس]

السلام عليكم

كيف يمكن تحديد المجال بالخلايا من c1:c5000 دون ان بطلب مني الكود تحديد المجال في كل مرة ؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟

[فلسطيني]

السلام عليكم التحية لجميع الأخوة خاصة معلمي الأستاذ محمد حجازي أدامه الله و حفظه من كل مكروه .

أعتقد أنك يمكنك استبدال

Set MyRange = Application.InputBox(prompt:="أدخل مجال الخلايا التي تريد إدراج الترقيم التلقائي فيها", Title:="مجال الخلايا", Type:=8)

بالتالي

Set MyRange = Worksheets("sheet1").Range("k2:k500")

مع ملاحظة تغيير اسم الشيت حسب ما هو موجود لديك

[محمد حجازي]

السلام عليكم ...

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

الاقتراح الثاني :

Sub MyNumbers()
    Dim i As Integer
    m = 1
    For Each MyCell In Worksheets("Sheet1").Range("C1:C5000").Cells
        i = i + m
        MyCell.Value = i
        If i = 1500 Then m = -1
        If i = 0 Then m = 1
    Next MyCell
End Sub