Ajouter (n fois) la cellule active et ajouter (+1)

Bonjour à tous,

Comment fonctionne cette Macro ?

Cette Macro, ajoute la cellule active autant de fois que le nombre indiqué dans InputBox, elle ajoute (+1) à chaque passage au nombre qui se trouve entre le tiret (-) et la slash (/).

Dans le fichier joint, la Macro fonctionne très bien et rapidement, ce qui n'est pas le cas malheureusement dans mon fichier réel sur lequel je travaille et qui est assez lourd.

Je me demandais s'il y'avait possibilité de le rendre plus rapide en utilisant des tableaux du genre "LBound UBound" que fâcheusement je ne sais pas mettre en œuvre vu mon expérience en vba.

Je reste à votre disposition si besoin d'autres informations supplémentaires.

Merci d'avance pour vos contributions.

Bonjour,

Essayez d'abord de neutraliser le rafraichissement de l'écran et le recalcul :

Sub Ajouter_Cellules()

Dim n, i, r, x, p

    If Selection.CountLarge <> 1 Then Exit Sub
    x = Selection
    n = Val(InputBox("Quel est le nombre de cellules à ajouter ?", "Ajouter autres cellules"))
    If n < 1 Then Exit Sub

    With Application
         .ScreenUpdating = False
         .Calculation = xlCalculationManual
    End With

    p = Split(Replace(x, "/", "-"), "-")
    r = Cells(Rows.Count, 1).End(xlUp).Row + 1
    For i = 1 To n
        Cells(r + i - 1, 1) = p(0) & "-" & _
        Format(p(1) + i, "000") & "/" & p(2)
    Next i

    With Application
         .ScreenUpdating = True
         .Calculation = xlCalculationAutomatic
    End With

End Sub

Bonjour Eric Kergresse,

Merci pour votre retour et l'ajustement du code.

En effet, l'exécution de la Macro se fait aussi rapidement dans mon fichier réel.

Bien à vous.

bonjour Harzer, salut Eric Kergresse,

vous voulez le faire avec une matrice, alors ...

Sub Ajouter_Cellules()
     Dim n, i, r, x, p, Arr

     If Selection.CountLarge <> 1 Then Exit Sub
     p = Split(Replace(Selection.Value2, "/", "-"), "-")
     If UBound(p) < 2 Then MsgBox "il n'y a pas 3 parties dans la sélection": Exit Sub

     n = Val(InputBox("Quel est le nombre de cellule à ajouter?", "Ajouter autres celluels"))
     If n < 1 Or n > 999 Then Exit Sub
     ReDim Arr(1 To n, 1 To 1)               'préparer une matrice d'autant éléments
     For i = 1 To n
          Arr(i, 1) = p(0) & "-" & Format(p(1) + i, "000") & "/" & p(2) 'concat des 3 parties
     Next i

     Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(n).Value = Arr 'coller le résultat
End Sub

et comme on n'a qu'une seule activité dans l'onglet, il ne faut pas s'occuper du screenupdating ou de la calculation.

Bonjour BsAlv & Eric Kergresse,

Content de vous retrouver BsAlv, il y'a un petit moment que nous n'avons pas échangé par clavier interposé.

Il est vrai que votre code est très rapide même sans utiliser screenupdating ou calculation, je prends!

Merci beaucoup et au plaisir de vous retrouver tous les deux à l'occasion.

Salutations amicales.