XL 2010 Copier N fois une valeur V dans une colonne donnée

anthony.unac · 7 Novembre 2018

Bonjour,

Le but est de copier N fois une valeur V dans une colonne donnée.
Soit une colonne A composée de mettons 10 valeurs (de A1 à A10)
Soit une colonne B composée de 10 valeurs également (de B1 à B10)
Dans la colonne C, est il possible de coller la valeur A1 (B1 fois c'est à dire que C1=A1, C2=A1, C3=A1 etc ... jusqu'à C_B1=A1). Juste en dessous de cette dernière cellule coller la valeur A2 (B2 fois c'est à dire C_B1+1=A2, C_B1+2=A2, C_B1+3=A2 etc ... jusqu'à C_B1+B2=A2) et ainsi de suite pour former une colonne C remplie d'occurences.

Cordialement
Anthony CANU

job75 · 7 Novembre 2018

Bonsoir anthony.unac,

Apparemment le même problème que sur ce fil :

https://www.excel-downloads.com/threads/generer-une-liste-a-partir-dun-critere-de-nombre.20027184/

Bonne nuit.

anthony.unac · 8 Novembre 2018

Oh bien vu ! Et d'ailleurs c'était vous à l'époque qui aviez donné la solution sans macro (de surcroît) j'apprécie. Merci beaucoup

anthony.unac · 8 Novembre 2018

Après test, on constate que la colonne se finit par des séquences #N/A.
J'ai tenté de m'en débarrasser en modifiant vos formules (voir fichier joint) mais du coup la colonne se finit par 0 tout le temps et je ne parviens pas à m'en débarrasser. Dans l'idéal, il faudrait que la colonne finisse par "rien" ="" mais sans le zéro final

mdo100 · 8 Novembre 2018

Bonjour le forum,
Bonjour anthony.unac,

A tester en "F3"

Code:

=SIERREUR(SI(SI(NB.SI(F$2:F2;F2)=INDEX(B:B;EQUIV(F2;A:A;0));INDEX(A:A;EQUIV(F2;A:A;0)+1);F2)=0;"";SI(NB.SI(F$2:F2;F2)=INDEX(B:B;EQUIV(F2;A:A;0));INDEX(A:A;EQUIV(F2;A:A;0)+1);F2));"")

Tirer vers le bas autant que nécessaire.

Où en "F3"

Code:

=SIERREUR(SI(NB.SI(F$2:F2;F2)=INDEX(B:B;EQUIV(F2;A:A;0));INDEX(A:A;EQUIV(F2;A:A;0)+1);F2);"")

Puis clique droit => Format de cellule => Personnalisée => et dans Type
Mettre Standard

Code:

Standard;;

Tirer vers le bas autant que nécessaire.

Cordialement.

job75 · 8 Novembre 2018

Bonjour anthony.unac, mdo100, le forum,

Oui c'est ça mdo100, ci-joint le fichier (2).

A+

anthony.unac · 8 Novembre 2018

Un grand merci à vous deux, ça marche parfaitement

anthony.unac · 8 Novembre 2018

Oups j'ai parlé trop vite, la formule fonctionne à ceci près qu'elle ne peut pas gérer les cas de figure ou le nombre de valeurs à copier est zéro (voir fichier joint ou j'ai colorié en vert le cas de figure)

Jocelyn · 8 Novembre 2018

Bonjour le Forum,
Bonjour Anthony.unac, Job75, mdo100

Dans la série pourquoi faire simple quand on peut faire compliqué et pour faire rire Job75 et mdo100 a tester en F3 et à étirer vers le bas

Code:

=SIERREUR(SI(NB.SI(F$2:F2;F2)<INDEX(B:B;EQUIV(F2;A:A;0));F2;INDEX(A:A;EQUIV(F2;A:A;0)+(SI(INDEX(B:B;EQUIV(F2;A:A;0)+1)=0;2;1))));"")

Cordialement

job75 · 8 Novembre 2018

Re, salut Jocelyn,

anthony.unac à dit:
Oups j'ai parlé trop vite, la formule fonctionne à ceci près qu'elle ne peut pas gérer les cas de figure ou le nombre de valeurs à copier est zéro

Eh oui, faut pas abuser des bonnes choses !

Jocelyn ta formule ne va plus s'il y a deux zéros (ou plus) consécutifs en colonne B

A+

Jocelyn · 8 Novembre 2018

re,

tout a fait Job après il faut voire si le cas de plusieurs zero a suivre existe c'est l'eternelle question

cordialement

anthony.unac · 8 Novembre 2018

Effectivement, il peut y avoir plusieurs valeurs à zéro à la suite mais je pense contourner le problème en forçant le nombre de fois à copier à 1 au minimum.

job75 · 8 Novembre 2018

Re,

Bien entendu avec VBA on fait tout ce qu'on veut, le code de la feuille :

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim t, a$, resu(), i&, j&, x, k&, n&
Application.EnableEvents = False 'désactive les évènements
With UsedRange
    t = .Columns(1).Resize(, 2) 'matrice, plus rapise
    a = .Columns(2).Address
    ReDim resu(1 To Evaluate("SUM(IF(ISNUMBER(" & a & "),INT(" & a & ")))"), 1 To 1)
    For i = 1 To UBound(t)
        j = Int(Val(t(i, 2)))
        x = t(i, 1)
        For k = 1 To j
            n = n + 1
            resu(n, 1) = x
    Next k, i
    If n Then
        .Columns(6).Resize(n) = resu 'restitution
        .Columns(6).Resize(n).Interior.ColorIndex = 6 'jaune
    End If
    .Cells(n + 1, 6).Resize(Rows.Count - n - .Row + 1).Clear 'RAZ en dessous
End With
With UsedRange: End With 'actualise la barre de défilement verticale
Application.EnableEvents = True 'réactive les évènements
End Sub

Fichier .xlsm joint.

A+

mdo100 · 8 Novembre 2018

Bonjour job75,

Ah si j'avais ce talent
En tout cas merci pour le code VBA, ça pourrait me servir qui sait

Cordialement.

anthony.unac · 8 Novembre 2018

Vous avez effectivement neutralisé l'ensemble des cas de figure problématiques et je compte bien l'adapter à ma feuille.
Dans cette dernière :
la colonne A devient la colonne B (Estimations)
la colonne B devient la colonne E (Crédibilité)
la colonne F devient la colonne G (data)
Du coup, j'ai essayé de modifier votre code et notamment les indices de colonne (columns(x)) comme ceci :

Code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim t, a$, resu(), i&, j&, x, k&, n&
Application.EnableEvents = False 'désactive les évènements
With UsedRange
    t = .Columns(2).Resize(, 2) 'matrice, plus rapise
    a = .Columns(5).Address
    ReDim resu(1 To Evaluate("SUM(IF(ISNUMBER(" & a & "),INT(" & a & ")))"), 1 To 1)
    For i = 1 To UBound(t)
        j = Int(Val(t(i, 2)))
        x = t(i, 1)
        For k = 1 To j
            n = n + 1
            resu(n, 1) = x
    Next k, i
    If n Then
        .Columns(7).Resize(n) = resu 'restitution
        .Columns(7).Resize(n).Interior.ColorIndex = 7 'jaune
    End If
    .Cells(n + 1, 7).Resize(Rows.Count - n - .Row + 1).Clear 'RAZ en dessous
End With
With UsedRange: End With 'actualise la barre de défilement verticale
Application.EnableEvents = True 'réactive les évènements
End Sub

Mais j'ai du oublié des modifications, pouvez vous m'aider à l'aide du fichier joint.

XL 2010 Copier N fois une valeur V dans une colonne donnée

anthony.unac

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

anthony.unac

XLDnaute Occasionnel

anthony.unac

XLDnaute Occasionnel

Pièces jointes

mdo100

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

Pièces jointes

anthony.unac

XLDnaute Occasionnel

anthony.unac

XLDnaute Occasionnel

Pièces jointes

Jocelyn

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Jocelyn

XLDnaute Barbatruc

anthony.unac

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

Pièces jointes

mdo100

XLDnaute Occasionnel

anthony.unac

XLDnaute Occasionnel

Pièces jointes

Discussions similaires