Liste de chiffres incrémentés en macro

Bonjour,

Je poste ici pour la 1ére fois.

J'ai pour le boulot besoin de fichier de données, avec la plupart du temps simplement une ou deux colonne(s) de chiffres qui se suivent. Par contre, la série de chiffres peut parfois être très longue...

A l'heure actuelle, on sélectionne une cellule dans laquelle on met le numéro de début, par exemple 0001, et on tire jusqu'au numéro de fin en incrémentant. Si on doit descendre jusque 5000, c'est un peu contraignant....

Je souhaite pouvoir créer une macro automatisant tout cela. J'ai déjà trouver sur le net quelque chose de très bien, mais qui n'incrémente pas la série qui est créée :

Sub Macro1()

Dim Col As String
Dim Deb As Integer, Fin As Integer, x As Integer
Dim Incr As Double

Col = Application.InputBox("Lettre Colonne ?", "Emplacement", "A")
Deb = Application.InputBox("Numero ligne Debut ?", "Debut", 1)
Fin = Application.InputBox("Numero ligne Fin ?", "Fin", 10)
Incr = Application.InputBox("Incrementation ?", "Incrementation", 5)

For x = Deb To Fin
    Range(Col & x) = Range(Col & x) + Incr
Next x

End Sub

Vous en remerciant par avance.

David

Bonjour,

Une piste avec AUtoFill :

Sub Macro1()

    Dim Col As String
    Dim Deb As Integer, Fin As Integer, x As Integer
    Dim Incr As Double

    Col = Application.InputBox("Lettre Colonne ?", "Emplacement", "A")
    Deb = Application.InputBox("Numero ligne Debut ?", "Debut", 1)
    Fin = Application.InputBox("Numero ligne Fin ?", "Fin", 10)
    Incr = Application.InputBox("Incrementation ?", "Incrementation", 5)

    Range(Col & Deb).Value = 1
    Range(Col & Deb + 1).Value = Incr

    Range(Col & Deb & ":" & Col & Deb + 1).AutoFill Range(Col & Deb & ":" & Col & Fin)

End Sub

Bonjour,

Essaye comme ça :

Sub Macro1()

Dim Col As String
Dim Deb As Integer, Fin As Integer, x As Integer
Dim Incr As Double

Col = Application.InputBox("Lettre Colonne ?", "Emplacement", "A")
Deb = Application.InputBox("Numero ligne Debut ?", "Debut", 1)
Fin = Application.InputBox("Numero ligne Fin ?", "Fin", 10)

Incr = Application.InputBox("Incrementation ?", "Incrementation", 1)

For x = Deb To Fin
    Range(Col & x) = Range(Col & x) + Incr
    Incr = Incr + 1
Next x

End Sub

EDIT : Oups, Theze a été plus rapide

Salut David B,

Salut l'équipe,

si tu dois faire ça souvent, ce sera sans doute plus facile avec ceci...

Fonctionnement :

• tu te positionnes sur la cellule de départ de ta série de nombres ;
• tu tapes tes infos d'incrémentation séparées par // ;

* le pas d'incrémentation ;

* la ligne d'arrivée ;

* option : nombres integer ou double

- ex: en [A1] : 1//2//5000 ou 1//2//5000//0

Série de nombres INTEGER (//0) démarrant en [A1], commençant par 1 avec une incrémentation de 2 jusque la ligne 5000.

J'imagine que tu utilises plus souvent des INTEGER, raison pour laquelle la dernière option peut être omise.

- en [C3] : 10.5//0.5//17000//1 ou //2 ou // 3 ou //5248.17 tant que ce n'est pas //0 (INTEGER)

Série de nombres DOUBLE(//1) démarrant en [C3], commençant par 10.5 avec une incrémentation de 0.5 jusque la ligne 17000.

Ici, la dernière info est obligatoire.

Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim tTab
Dim iType%, sCol$
'
If Target.Count > 1 Then Exit Sub
If InStr(Target, "//") > 0 Then
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    '
    tTab = Split(Target, "//")
    If UBound(tTab) = 2 Then iType = 0
    If UBound(tTab) = 3 Then iType = CInt(Split(Target, "//")(3))
    sCol = Split(Columns(Target.Column).Address(ColumnAbsolute:=False), ":")(1)

    tTab = Range(sCol & Target.Row & ":" & sCol & Split(Target, "//")(2)).Value
    tTab(1, 1) = IIf(iType = 0, CInt(Split(Target, "//")(0)), CDbl(Split(Target, "//")(0)))
    '
    For x = 2 To UBound(tTab, 1)
        tTab(x, 1) = IIf(iType = 0, CInt(tTab(x - 1, 1)) + CInt(Split(Target, "//")(1)), CDbl(tTab(x - 1, 1)) + CDbl(Split(Target, "//")(1)))
    Next
    Range(sCol & Target.Row).Resize(UBound(tTab, 1), 1).Value = tTab
    '
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End If
'
End Sub

Pense pas que tu auras le temps d'aller boire un café!

A+

Bonjour à vous, et merci pour vos réponses.

Tout fonctionne, merci infiniment, et la solution de Curulis est en fait encore plus adapté pour certaines fois ou je doit renseigner plusieurs champs rapidement. Du coup je conserve l'ensemble des solutions.

Je travail dans l'imprimerie, et ces données me servent à faire des carnets ou autres tickets numérotés.

Grand merci à vous de nouveau !