Créer un doublon Fermé

Question

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

michel_m · Answer

Bonjour

peux tu expliquer
 "doublons d'une ligne" ?
d'avance merci

pépé35530 · Answer

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é

michel_m · Answer

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

Créer un doublon

3 réponses

Discussions similaires