Sujet Précédent Sujet Suivant

Créer un doublon

maurtoss -  
michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   -
Bonjour,

Je travaille sur une feuille excel avec 3000 lignes à une colonne. Et j'aimerais créer des doublons d'une ligne si la cellule contient la lettre "&".
Comment faire?

merci pour vos réponses

3 réponses

Réponse 1 / 3
michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 318
 
Bonjour

peux tu expliquer
"doublons d'une ligne" ?
d'avance merci
0
maurtoss
 
oui tout à fait!
voici un exemple:
En colonne a j'ai ça:

1 papa
2 papa & maman
3 bebe & papa
4 bebe

et j'aimerai avoir ça:

1 papa
2 papa & maman
3 papa & maman
4 bebe & papa
5 bebe & papa
6 bebe
0
Réponse 2 / 3
pépé35530 Messages postés 3014 Date d'inscription   Statut Membre Dernière intervention   1 390
 
Bonjour,

Une manip un peu compliquée mais qui doit pouvoir être automatisée :

Créer une colonne et rentrer la formule suivante :

=SI(TROUVE("&";A2:A23;1)>0;0;1)

A2 contient l'information à tester
A2:A23 les cellules à tester (à adapter). on peut aussi donner un nom.

Les cellules répondant au critère afficheront un 0 ou bien un message d'erreur.

Utiliser ensuite le filtre afin de ne faire apparaître que les lignes contenant un 0
faire un copier de ces lignes
faire à nouveau apparaître toutes les lignes via le filtre
se positionner à la fin du tableau et faire un coller.
utiliser le filtre pour trier à nouveau la liste.

A+

pépé
0
Réponse 3 / 3
michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 318
 
re,

ci dessous macro avec colonne A et restitution en colonne B à adapter 

Option Explicit
Option Base 1
Const col  As String = "A"

Sub doubler_ligne_si()
Dim derlig As Integer
Dim T_in, T_out
Dim Cptr_in As Integer, Cptr_out As Integer

'---------initialisations
derlig = Columns(col).Find("*", , , , , xlPrevious).Row
T_in = Application.Transpose(Range(Cells(1, col), Cells(derlig, col)).Value)
ReDim T_out(1)
Cptr_out = 1
'--------- établissement des lignes doublées
For Cptr_in = 1 To UBound(T_in)
     ReDim Preserve T_out(Cptr_out)
     T_out(Cptr_out) = T_in(Cptr_in)
     Cptr_out = Cptr_out + 1
     If T_in(Cptr_in) Like "*&*" Then
          ReDim Preserve T_out(Cptr_out)
          T_out(Cptr_out) = T_in(Cptr_in)
          Cptr_out = Cptr_out + 1
     End If
Next

'---------restitution
 Cells(1, "B").Resize(UBound(T_out), 1) = Application.Transpose(T_out)

End Sub
0