XL 2016 Répéter le contenu d'une cellule en fonction d'une valeur

[Sylvain21]

Bonjour à tous,

Voici ma problématique que je n'arrive pas à solutionner :

Je souhaite répéter le contenu d'une cellule dans un certains nombre de cellules adjacentes en fonction d'un nombre de répétition.

En pj une description plus parlante des conditions à respecter.

Par avance merci

Cordialement
Sylvain

 

[st007]

Bonsoir,
une approche moyennement fonctionnelle, il faut re selectionner la cellule à recopier

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Target, Range("C7:H11")) Is Nothing Then
recopie = Cells(Target.Row, 9).Value
Select Case recopie
Case 0
Exit Sub
Case 1
Target.Offset(, -1) = Target.Value
Case 2
Union(Target.Offset(, -1), Target.Offset(, -2)) = Target.Value
Case 3
Union(Target.Offset(, -1), Target.Offset(, -2), Target.Offset(, -3)) = Target.Value
Case 4
Union(Target.Offset(, -1), Target.Offset(, -2), Target.Offset(, -3), Target.Offset(, -4)) = Target.Value
Case 5
Union(Target.Offset(, -1), Target.Offset(, -2), Target.Offset(, -3), Target.Offset(, -4), Target.Offset(, -5)) = Target.Value
End Select
End If
End Sub

 

[Bernard_XLD]

Bonjour Sylvain21, st007, le forum

Une proposition en fonction personnalisée, compte le nombre de couleurs égales à la couleur de la cellule contenant la fonction.

Cordialement, @+

Function Nbr_Couleurs(Target As Range)
Dim Cel_Ref As Range, Nb_Coul&
Application.Volatile
For Each Cel_Ref In Target
    If Application.ThisCell.Interior.Color = Cel_Ref.Interior.Color Then Nb_Coul = Nb_Coul + 1
Next
Nbr_Couleurs = Nb_Coul
End Function

 

[job75]

Bonjour Sylvain21, st007, Bernard,

Avec le double-clic :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [A7:H11]) Is Nothing Then Exit Sub 'plage à adapter
Dim prem As Range
Cancel = True
Set prem = Cells(Target.Row, Application.Max(Target.Column - Cells(Target.Row, 9), 1))
Target.Copy Range(prem, Target) 'copier-coller
End Sub

A+