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

  1. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
     
    Bonjour

    peux tu expliquer
    "doublons d'une ligne" ?
    d'avance merci
    0
    1. 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
  2. pépé35530 Messages postés 2951 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
  3. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
     
    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