دق الارقام السرية

[ابوصلاح]

اريد دالة لدق الارقام السرية من خلال جدول محدد به المجموعات

دق الارقام السرية.rar

[مختار حسين محمود]

 

 

Sub AutoNumbering()

ActiveCell = ActiveCelltiveCell
NS:
A = Application.InputBox("أدخل أول رقم فى السلسلة التى تريد إنشاؤها", "أول رقم")
B = Application.InputBox("أدخل آخر رقم فى السلسلة التى تريد إنشاؤها", "آخر رقم")

If A = False Or B = False Then
Exit Sub
ElseIf A = "" Or B = "" Then
MsgBox "!تأكد من إدخال الأرقام بشكل صحيح", vbExclamation, "إدخال خاطئ"
Else

If [IV65536] = 1 Then
ActiveCell = A
Else: Columns(ActiveCell.Column).Rows(65536).End(xlUp).Select
If ActiveCell = "" Then
ActiveCell = A
Else: ActiveCell.Offset(1, 0).Select
Selection = A
End If
End If
ActiveCell.DataSeries xlColumns, , , 1, B
End If

If Application.WorksheetFunction.CountA(Columns(ActiveCell.Column)) = 1 Then
ActiveCell.ClearContents
Beep
If MsgBox("أول رقم فى السلسلة أكبر من آخر رقم ... هل تود إعادة المحاولة ؟", vbQuestion + vbYesNo, " إدخال خاطئ") = vbNo Then
Exit Sub
Else: GoTo NS
End If
End If

Beep
If MsgBox("هل تود إنشاء سلسلة رقمية أخرى ؟", vbYesNo + vbQuestion, "إنشاء سلسلة أخرى") = vbNo Then
Exit Sub

Else: GoTo NS

End If
End Sub

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

[ابوصلاح]

بلا شك الكود رائع وانا اعمل به لكن مجرد فكرة انني اطبقها بالمعادلات شكرا اخي مختار