Créer un doublon
maurtoss
-
michel_m Messages postés 18903 Date d'inscription Statut Contributeur Dernière intervention -
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
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
-
Bonjour
peux tu expliquer
"doublons d'une ligne" ?
d'avance merci -
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é -
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