الدالة المعرفة SEQUENCE بديل للدالة الخاصة بمايكروسوفت

=SEQUENCE([rows],[columns],[start],[step],[cell_database])

Private Sub addin(rng As Range, vl As Variant): rng = vl: End Sub



Function SEQUENCE(Optional rows As Long = 1, Optional columns As Integer = 1, Optional start As Double = 1, Optional step As Double = 1, Optional tmp As Range) As Variant

'Developer: Eslam Abdullah

Application.Volatile False

    Dim x&, y%, i%, s%, e%, t$, chk



    If rows < 1 Or columns < 1 Then

        GoSub clr: SEQUENCE = CVErr(xlErrNum)

        Evaluate "addin(" & tmp.Address(, , , 1) & ","""" )"

        Exit Function

    End If



    GoSub clr: GoSub rnk: SEQUENCE = start

    If Not tmp Is Nothing Then Evaluate "addin(" & tmp.Address(, , , 1) & ",""" & Application.Caller.Resize(rows, columns).Address & """)"

    For x = 1 To rows

        For y = 1 To columns

            If x + y > 2 Then

                Evaluate "addin(" & Application.Caller.Offset(x - 1, y - 1).Address(, , , 1) & ",""" & Evaluate(Application.Replace(Application.Caller.Formula, s, e, (columns * (x - 1) + y) * step - (step - 1) + (start - 1))) & """)"

            End If

        Next y

    Next x

Exit Function



clr:

    If Not tmp Is Nothing Then chk = Evaluate("ISREF(" & tmp & ")")

    If IsNumeric(chk) Then

        If chk Then

            If Range(tmp).rows.Count & Range(tmp).columns.Count = rows & columns Then Evaluate "addin(" & tmp.Address(, , , 1) & ",""" & Application.Caller.Resize(rows, columns).Address & """)"

            If Range(tmp).rows.Count > 1 Then Evaluate "addin(" & Mid(Application.Caller.Address(, , , 1), 1, InStr(Application.Caller.Address(, , , 1), "!")) & Range(Range(tmp).Cells(2, 1), Range(tmp).Cells(Range(tmp).rows.Count, Range(tmp).columns.Count)).Address & ","""" )"

            If Range(tmp).columns.Count > 1 Then Evaluate "addin(" & Mid(Application.Caller.Address(, , , 1), 1, InStr(Application.Caller.Address(, , , 1), "!")) & Range(Range(tmp).Cells(1, 2), Range(tmp).Cells(1, Range(tmp).columns.Count)).Address & ","""" )"

        End If

    End If

Return



rnk:

t = Application.Caller.Formula

For i = 2 To Len(t)

    If Mid(t, i, 1) = """" Then i = InStr(i + 1, t, """") + 1 Else If Mid(t, i, 9) = "SEQUENCE(" Then s = i: Exit For

Next i

For i = s + 9 To Len(t)

    Select Case Mid(t, i, 1)

        Case """": i = InStr(i, t, """") + 1

        Case "(": i = InStr(i, t, ")") + 1

        Case ")": e = i - s + 1: Exit For

    End Select

Next i

Return

End Function