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

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

قام بنشر

تفضلوا مشاركة منى بالاكواد

Sub Test()
    Dim numx As Long, x As Long, z As Long, bb As Byte
    Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
    bb = Range("D1").Value
    numx = bb
    numl = Range("F1").Value
    ReDim y(1 To numl, 1 To 1)
    For x = 1 To numl
        If x = numx Then numx = numx + bb: GoTo 86
        If x <> numx Then
            z = z + 1
            y(z, 1) = x
        End If
86  Next
    If z > 0 Then Cells(1, 1).Resize(z, 1).Value = y()
    MsgBox "Done.....  (-_-)"
End Sub

نقوم بوضع الرقم المراد تخطيه وتخطى مضاعفاته ونضع اخر رقم بالسلسلة الرقمية  ونقوم بتنفيذ الكود
تحياتي

:fff:

special_sequence.rar

  • Like 4
قام بنشر
 

تفضلوا مشاركة منى بالاكواد


Sub Test()
    Dim numx As Long, x As Long, z As Long, bb As Byte
    Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
    bb = Range("D1").Value
    numx = bb
    numl = Range("F1").Value
    ReDim y(1 To numl, 1 To 1)
    For x = 1 To numl
        If x = numx Then numx = numx + bb: GoTo 86
        If x <> numx Then
            z = z + 1
            y(z, 1) = x
        End If
86  Next
    If z > 0 Then Cells(1, 1).Resize(z, 1).Value = y()
    MsgBox "Done.....  (-_-)"
End Sub

نقوم بوضع الرقم المراد تخطيه وتخطى مضاعفاته ونضع اخر رقم بالسلسلة الرقمية  ونقوم بتنفيذ الكود
تحياتي

:fff:

special_sequence.rar

نفس الكود لكن بطريقة مختصرة

Sub Test1()
    Dim x As Long, bb As Byte, m As Integer
    Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
    m = 0: bb = Range("D1").Value: numl = Range("F1").Value
    For x = 1 To numl: If x Mod bb = 0 Then x = x + 1
    Cells(m + 1, 1) = x: m = m + 1: Next
    MsgBox "Done.....  (-_-)"
End Sub

 

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