كود لتسلسل الارقام

[alihgrvdad123]

السلام عليكم ..ممكن كود لتسلسل الارقام 

عند وضع رقم 3 يقوم الكود يحذف رقم 3 ووضع مكانه 4  وهكذا  يثوم بحذف رقم 4 ووضع مكانه رقم 5  ..جزيتم خيرا

كود يقوم بقراءة الارقام عدها أي تسلسل الارقام.xlsx

[ابراهيم الحداد]

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

استخدم المعادلة التالية

=OFFSET(البيانات!$A$2;COUNT(البيانات!$A:$A)-1;0)

 

[alihgrvdad123]

السلام عليكم ..اعتذر استاذ ابراهيم :  ..م أوصل الفكرة - اعتذر ..المطلوب هو 

عداد الارقام شبيه تايمر الوقت ..في نفس الخلية ، فمثلا : عند كتابة رقم 3 بعد ثانية يتحول الى رقم 4 وبعد ثانية يتحول الى رقم 5 وهكذا

 

 

 

 

[محمد هشام.]

صراحة لم أستوعب الطلب جيدا ...جرب أخي 

Sub cal_MH()
 Dim LastRow As Long
   Dim i As Long, j As Long
   Application.Calculation = xlManual
   With Worksheets("البيانات")
      LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row - 1
   End With
For i = 1 To LastRow
       With Worksheets("فاتورة")
Application.Wait (Now + TimeValue("00:00:01"))
        Range("A2").Value = i
        
       End With
   Next i
    Application.Calculation = xlAutomatic
End Sub

كود يقوم بقراءة الارقام عدها أي تسلسل الارقام.xlsm

[alihgrvdad123]

السلام عليكم ..العداد تمام ..فقط شغلة واحدة - ارجو التعديل عليها

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

كود عداد الارقام.xlsm

[محمد هشام.]

اخي لا اعلم الغرض من الفكرة لاكن اظن انه من  الانسب لصق جميع القيم مباشرة وحدفها بعد الانتهاء من العد ادا لزم الامر

اليك بديل ربما يناسبك نسخ جميع القيم من شيت البيانات الى شين فاتورة  مع كود لتصفح القيم المحصل عليها واستخراج عددها  .

Sub cal()
Dim MH&
With Worksheets("البيانات")
Range("A3:A50").ClearContents
Range("B2").ClearContents
    MH = .Cells(.Rows.Count, "A").End(xlUp).Row - 1
    Worksheets("فاتورة").Range("A1").Resize(MH).Value = .Columns(1).Resize(MH).Value
    Application.Goto Worksheets("فاتورة").Range("A2")
End With
For MH = 1 To MH
       With Worksheets("فاتورة")
        Range("b2").Value = MH
        
       End With
       Next MH
End Sub

Private Sub worksheet_selectionchange(ByVal target As Range)
Dim r As Range
With Me
Application.Calculation = xlManual
    MH = .Cells(.Rows.Count, 1).End(xlUp).Row
    Set r = Intersect(target, .Columns(1).Resize(MH))
    If Not r Is Nothing Then
        If r.Cells.Count = 1 Then
            PrevColor = r.Interior.Color
            r.Interior.Color = vbGreen
            Application.Wait Now + TimeValue("00:00:01")
            r.Interior.Color = PrevColor
            r.Offset(1).Activate
     Application.ScreenUpdating = False
    ActiveWindow.ScrollRow = 1
    Range("A2:A50").ClearContents
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
        End If
    End If
End With
End Sub

كود عداد الارقام.xlsm

[alihgrvdad123]

جزيت خيرا