كود للترقيم التلقائي

[ماجد القثمي]

السلام عليكم 

أعزائي الاعضاء

عندي طلب اتمنى يكون بسيط وسهل

نعرف داله الترقيم التلقائي 

=IF(B2="","",SUBTOTAL(3,$B$2:$B2))

.والتي تستخدم للترقيم  التلقائي والتعديل على الترقيم في حال حذف القيمه من احد السطور العلويه

:الطلب

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

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub

بحيث يتم تطبيق كود الترقيم على كامل العمود (A) مثلا تلقائيا بمجرد الكتابه في العمود (B)

وشكرا لكم

تم تعديل فبراير 10, 2016 بواسطه ماجد القثمي

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

جرب التالي ولا حاجة للكود (يمكنك سحب المعادلة غلى اي صف تريد)

Count_rows.rar

تم تعديل فبراير 10, 2016 بواسطه سليم حاصبيا

[dear121212]

الشكر موصول للجميع مع تمنياتى بالتوفيق لكل القائمين على ادارة المنتدى والمشاركين فى المنتدى

بصراحة ما من معلومة  احتجت اليها الا ووجدتها

اللهم وفق الجميع واغفر لنا واهدنا جميعا لما تحب وترضى

[رجب جاويش]

أخى الفاضل

جرب هذا الكود

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Rng As Range, LR As Integer
LR = Cells(Rows.Count, 2).End(xlUp).Row
Set Rng = Range(Cells(1, 1), Cells(LR, 1))
Rng.Formula = "=IF(NOT(ISBLANK(B1)),COUNTA(B$1:B1),"""")"
End Sub

 

[ماجد القثمي]

شكرا يا اخوان على تفاعلكم ومساعدتكم

الاستاذ / رجب جاويش هذا هو ما اريد بالضبط

شكرا جزيلا لك