اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

  • أفضل إجابة
قام بنشر (معدل)

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

جرب هدا 

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim srcWS As Worksheet, début As Long, Fin As Long
    Dim a As Variant, b As Variant, i As Long
    
    Set srcWS = Me
    a = srcWS.[B3].Value
    b = srcWS.[C3].Value

    If Not Intersect(Target, srcWS.Range("B3:C3")) Is Nothing Then
        If a = "" Or b = "" Then Exit Sub
        
        If IsNumeric(a) And IsNumeric(b) Then
            début = a
            Fin = b
            
            If début <= Fin Then
             srcWS.Range("F7:F" & srcWS.Rows.Count).ClearContents 
                For i = début To Fin
                    srcWS.Cells(6 + i - début + 1, "F").Value = i
                Next i
            Else
       MsgBox _
       " بداية الترقيم يجب أن تكون أصغر أو تساوي نهاية الترقيم", vbExclamation, "خطأ في الإدخال"
     
            End If
        End If
    End If
End Sub

 بالمعادلات 

=IF(ROW(F7)-ROW($F$7)+$B$3<=$C$3, ROW(F7)-ROW($F$7)+$B$3, "")

ترقيم.xlsb

تم تعديل بواسطه محمد هشام.
  • Like 3
قام بنشر
27 دقائق مضت, محمد زيدان2024 said:

@محمد هشام.  مبدع ورائع الكود تمام . لكن المعادلة خطأ

المعادلة ليس بها أي خطأ أخي @محمد زيدان2024 ربما قمت بوضعها بشكل غير صحيح 

ScreenRecorderProject5.gif.f1a7001901291686e67f6f73eeff887e.gif

 

معادلة ترقيم.xlsx

  • Like 1

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information