Vous aurez besoin d'un événement Worksheet_Change () :

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Address = "$A$1" Then

        Range("A2:A1048576").ClearContents

        For i = 1 To Target.Value
            Cells(i + 1, 1).Value = i
        Next i

    End If

End Sub

En utilisant des formules:

dans A2 utilisez la formule suivante:

=IFERROR(IF(A2+1>A$1,"",A2+1),"")

Dans A3 utilisez:

=IFERROR(IF(A1="","",1),"")

Et remplissez

Numéroté

Caractéristiques

• Lorsque la valeur de Plage de cellules source est modifiée par l'entrée utilisateur ou via VBA, le le programme est déclenché. Il ne fonctionnera pas si Plage de cellules source contient une formule et que la valeur a changé en raison d'un autre changement de cellule. Pour cette fonctionnalité, vous devez utiliser l'événement Worksheet Calculate .
• Si la valeur n'est pas un nombre, rien ne se passera.
• Si la valeur est un nombre décimal ( 1,5 ), elle sera arrondie au plus proche entier ( 2 ).
• Si la valeur dépasse le nombre de lignes de la feuille de calcul, le la feuille de calcul sera remplie dans la cellule du bas. Le reste des valeurs sera ignoré.
• Modifiez l ' Adresse de la plage de cellules source dans Worksheet_Change (définie sur A1 ) en fonction de vos besoins, par exemple C17 . Seules les cellules ci-dessous seront concernées.

Le Code

Copiez le code suivant dans un module standard ( VBE >> Insert >> Module ) par exemple p>

Module1

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Const cSrc As String = "A1"  ' Source Cell Range Address

    If Target.Address = Range(cSrc).Address Then
        Numbered Target
    End If

End Sub

Copiez le code suivant dans n'importe quel module de feuille où vous souhaitez exécuter le programme par exemple

Sheet1

Option Explicit

Sub Numbered(CellRange As Range)

    Dim vntT As Variant          ' Target Array/Value
    Dim srcVal As Variant        ' Value
    Dim srcMax As Long           ' Maximum Value
    Dim srcSgn As Long           ' Sign (+-)
    Dim srcAbs As Long           ' Absolute Value
    Dim i As Long                ' Target Array Row Counter

    ' In Cell Range
    With CellRange
        ' Write value of CellRange to Value.
        srcVal = .Value
        ' Calculate Maximum Value.
        srcMax = .Worksheet.Rows.Count - .Offset(1).Row + 1
    End With

    ' Check if Value is a number.
    If IsNumeric(srcVal) Then
        ' Convert Value to whole number.
        srcVal = CLng(srcVal)
        ' Write the sign of Value to Sign.
        srcSgn = Sgn(srcVal)
        ' Check if the absolute value of Value is greater than Maximum Value.
        If Abs(srcVal) > srcMax Then
            ' Write Maximum Value with (correct) Sign to Value.
            srcVal = srcSgn * srcMax
        End If
        ' Write the absolute value of Value to Absolute Value.
        srcAbs = Abs(srcVal)
        ' Check Absolute Value
        Select Case srcAbs
            Case Is > 1
                ' Resize Target Array to Absolute Value rows and one column.
                ReDim vntT(1 To srcAbs, 1 To 1)
                ' Loop through rows of Target Array.
                For i = 1 To srcAbs
                    ' Write to element at i-th row and 1st column
                    ' of Target Array.
                    vntT(i, 1) = srcSgn * i
                Next
            Case 1
                ' If Absolute Value is 1, vntT will not be an array, but a
                ' variant containing one value.
                vntT = srcSgn * 1
            Case 0
                ' If Absolute Value is 0, vntT will not be an array, but a
                ' variant containing one value.
                vntT = 0 ' or ""
        End Select
    End If

    ' In First Cell of Target Range (Cell Below Cell Range)
    With CellRange.Offset(1)
        ' Resize to bottom cell and clear contents.
        .Resize(srcMax).ClearContents
        ' Check if vntT is an array.
        If IsArray(vntT) Then   ' Multiple values
            ' Calculate Target Range: Resize First Cell of Target Range by
            ' Absolute Value.
            ' Copy Target Array to Target Range.
            .Resize(srcAbs) = vntT
          Else                  ' One value
            ' Write Target Value to First Cell of Target Range.
            .Value = vntT
        End If
    End With

End Sub