XL 2019 Copier une cellule d'une ligne toutes les 5 lignes

[lynyrd]

Bonjour le forum
en VBA je souhaiterai copier une cellule d'une ligne toutes les 5 lignes
Merci.

 

[sylvanu]

Bonjour Lynyrd,
Peut être avec cette formule :

=SI(MOD(LIGNE();5)=1;$A$1;"")

 

[lynyrd]

Merci sylvanu
c'est parfait
A+

 

[job75]

Bonjour lynyrd, sylvany,

En VBA ça donne ceci :

Sub TirerCellule()
Dim source As Range, dest As Range, pas&, n
Set source = [A1]
Set dest = [B1]
pas = 5
n = Int(Val(Application.InputBox("Nombres de cellules à remplir :")))
dest.EntireColumn.Replace source, "", xlWhole 'RAZ
If n < 1 Then Exit Sub
dest = source
For n = 1 To n - 1
    dest.Offset(pas) = dest
    Set dest = dest.Offset(pas)
Next
End Sub

A+

 

[lynyrd]

Toujours le meilleur job75
Merci.

 

[sylvanu]

Re,
"Just for the fun" un simple essai avec plusieurs solutions VBA pour voir quel algo serait le plus rapide, par boucle, par formules, par array, pour un nombre élevé de cellules à remplir.
Sur mon PC l'approche par formule est le plus rapide.

 

[job75]

Bonjour le forum,

Sur mon PC l'approche par formule est le plus rapide.

Chez moi c'est l'Array :

Test1 avec boucle 0,080 s
Test2 avec formules 0,016 s
Test3 avec array 0,012 s.

A+

 

[job75]

L'inconvénient de la solution ave formules c'est qu'elle efface les autres cellules.

Pour l'array il vaut mieux écrire :

Sub TirerCellule3()
    ' Par array
    Dim T0, n, T, V
    T0 = Timer
    n = [E4]: V = [A1]
    [B:B].Replace V, "", xlWhole
    T = Range("B1:B" & 5 * n)
    For i = 1 To 5 * n Step 5
        T(i, 1) = V
    Next i
    [B1].Resize(UBound(T, 1), UBound(T, 2)) = T
    [E12] = Timer - T0
End Sub

 

[sylvanu]

Bonjour Job,

Chez moi c'est l'Array :

Je me suis aperçu que plus la version XL est récente plus les formules sont "lentes". Très surement par optimisation sur d'autres critères que le temps. Par contre elles sont de plus en plus puissantes.
Une sorte d'équilibre : on perd un tout petit peu de temps mais on gagne énormément en puissance.