Incrémentation spéciale cellules

Version imprimable

19/03/2010, 17h34
lafafmentvotre

Incrémentation spéciale cellules

Bonjour à tous

Je cherche le moyen d'incrémenter une série "spéciale" dans Excel.

Je m'explique, ma série commence par :

10A070
10A075
10A079
10A080
10A085
10A089

Je souhaiterais pouvoir incrémenter pour que suivent :

10A090
10A095
10A099
10A100
10A105
10A109
....

Est ce possible ?

Merci par avance pour l'aide ou les conseils

Code:

1
2
3
4
5
6
Sub tst()
Dim i As Long
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    Range("B" & i) = "10A" & Format(Int(Mid(Range("A" & i), 4)) + 20, "000")
Next i
End Sub

19/03/2010, 19h47
lafafmentvotre

Super Merci

Mais je vois qu'en fait cela analyse ce qu'il y a en colonne A et incrémente dans la colonne B.

Est ce possible de le faire en suivant vers le bas et éventuellement d'indiquer quand la boucle doit s'arrêter (soit en indiquant la veleur de fin ou le nombre d'incréments ?

Merci par avance

Code:

1
2
3
4
5
6
7
8
9
10
11
Sub tst()
Dim i As Long, k As Long
Dim L As Integer
'L = InputBox("nombre d'incréments")
L = 6 'nombre d'incréments à adapter
k = Cells(Rows.Count, 1).End(xlUp).Row + 1
For i = 1 To L
    Range("A" & k) = "10A" & Format(Int(Mid(Range("A" & i), 4)) + 20, "000")
    k = k + 1
Next i
End Sub

19/03/2010, 20h08
lafafmentvotre

Alors là suis bluffé merci.

Par contre si je lance de nouveau la macro (avec 6 en L, par exemple), il n'incrémente pas dans la continuité de la dernière cellule mais il reprend plus haut. Je ne vis pas dans le script comment lui indiquer cela......

Merci pour l'aide

Code:

1
2
3
4
5
6
7
8
9
10
11
Sub tst()
Dim i As Long, k As Long, L As Long
 
L = Cells(Rows.Count, 1).End(xlUp).Row
k = L + 1
Do
    i = i + 1
    Range("A" & k) = "10A" & Format(Int(Mid(Range("A" & i), 4)) + 20, "000")
    k = k + 1
Loop Until i = L
End Sub

19/03/2010, 20h25
lafafmentvotre

Merci mais c'est pareil, il incrémente en reprenant plus haut
19/03/2010, 20h37
mercatog

ta série à incrémenter de la sorte commence à partir de quelle position?
19/03/2010, 21h00
lafafmentvotre

Elle commence en A1
Mais je dois aussi penser pour la suite qu'elle peut commencer ailleurs dans la feuille

Ok, j'ai relis ton premier message

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub Test()
Dim i As Long, k As Long, L As Long
Dim vo As Byte, j As Byte
Dim Dec, Aj
Dec = Array(0, 5, 9)
Aj = Array(5, 4, 1)
L = Cells(Rows.Count, 1).End(xlUp).Row
vo = CByte(Right(Range("A" & L), 1))
 
For j = 0 To 3
    If Dec(j) = vo Then Exit For
Next j
 
k = L + 1
Do
    i = i + 1
    Range("A" & k) = "10A" & Format(Int(Mid(Range("A" & k - 1), 4)) + Aj(j), "000")
    k = k + 1
    j = (j + 1) Mod 3
Loop Until i = L
End Sub

19/03/2010, 21h41
lafafmentvotre

Génial merci
et pour remettre une input box ?
Je peux me baser sur quelle variable pour incrémenter un certain nombre ?

Merci

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub LAFAF()
Dim i As Long, k As Long, L As Long
Dim vo As Byte, j As Byte
Dim Dec, Aj, Vm
 
Vm = InputBox("Nombre d'incrémentations")
If IsNumeric(Vm) Then
    Vm = iif(Vm<1,1,CInt(Vm))
    Dec = Array(0, 5, 9)
    Aj = Array(5, 4, 1)
    L = Cells(Rows.Count, 1).End(xlUp).Row
    vo = CByte(Right(Range("A" & L), 1))
 
    For j = 0 To 3
        If Dec(j) = vo Then Exit For
    Next j
 
    k = L + 1
    Do
        i = i + 1
        Range("A" & k) = "10A" & Format(Int(Mid(Range("A" & k - 1), 4)) + Aj(j), "000")
        k = k + 1
        j = (j + 1) Mod 3
    Loop Until i = Vm
End If
End Sub

Edit: une rectification au niveau de Vm

19/03/2010, 22h03
lafafmentvotre

Cela fonctionne à merveille.

Merci mille fois Mercatog et bonne soirée

à force de changer le code, le résultat final comporte parfois des bizarreries
ci-joint code modifié et plus optimisé

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub LAFAF()
Dim i As Long, L As Long
Dim vo As Byte, j As Byte
Dim Dec, Aj, Vm
 
Vm = InputBox("Nombre d'incrémentations")
If IsNumeric(Vm) Then
    Vm = IIf(Vm < 1, 1, CInt(Vm))
    Dec = Array(0, 5, 9)
    Aj = Array(5, 4, 1)
    L = Cells(Rows.Count, 1).End(xlUp).Row
    vo = CByte(Right(Range("A" & L), 1))
 
    For j = 0 To 3
        If Dec(j) = vo Then Exit For
    Next j
 
    For i = 1 To Vm
        Range("A" & L + 1) = "10A" & Format(Int(Mid(Range("A" & L), 4)) + Aj(j), "000")
        L = L + 1
        j = (j + 1) Mod 3
    Next i
End If
End Sub

19/03/2010, 22h31
lafafmentvotre

Merci, super