[Excel] Comment trouver le contenu d'une cellule dans une ligne, puis la copier

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion Kirko
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
K

Kirko

XLDnaute Nouveau
Bonjour à tous,

j'ai un fichier Excel qui s'organise de cette facon (Voir PJ):
........a............... b ................c ................d .................e
1 VER:Savoir PRO:Je ADV:Bien ART:Le NOM: Matin
2 PRO:Il ART:LA VER:etre INT: Ah ADJ: Beau
3 ETC......
4
5

Ce que je voudrais faire, ca serait de mettre sous une colonne tous les VER, sous une autre tous les ART, ainsi de suite ... Pour cela, ce que je pensais faire, c'etait d'entrer une formule, en lui demandant de rechercher pou chaque ligne "VER" et de copier alors la cellule dans la colonne dédiée au verbes ... mais je n'arrive pas à le faire.

C'est pourquoi je viens à vous.
En vous remerciant d'avance.
 

Pièces jointes

Trier par date Trier par votes
Re : [Excel] Comment trouver le contenu d'une cellule dans une ligne, puis la copier

Bonjour Kirko,

Je suis désolé de pas pouvoir plus t'aider dans l'immédiat mais j'ai fait ce petit code en vba :

VB: 
Sub tri()
    'Déclaration des différents compteur de lignes
    Dim lignPRO As Integer
    Dim lignDET As Integer
    Dim lignVER As Integer
    Dim lignADV As Integer
    For i = 1 To Sheets("Feuil1").Range("A65536").End(xlUp).Row
        For j = 0 To Sheets("Feuil1").Range("IV" & i).End(xlUp).Row
            If Sheets("Feuil1").Range("A" & i).Offset(0, j).Value Like "PRO*" Then
                Sheets("Feuil2").Range("A1").Offset(lignPRO, 0).Value = Sheets("Feuil1").Range("A" & i).Offset(0, j).Value
                lignPRO = lignPRO + 1
            End If
            If Sheets("Feuil1").Range("A" & i).Offset(0, j).Value Like "DET*" Then
                Sheets("Feuil2").Range("B1").Offset(lignDET, 0).Value = Sheets("Feuil1").Range("A" & i).Offset(0, j).Value
                lignDET = lignDET + 1
            End If
            If Sheets("Feuil1").Range("A" & i).Offset(0, j).Value Like "VER*" Then
                Sheets("Feuil2").Range("C1").Offset(lignVER, 0).Value = Sheets("Feuil1").Range("A" & i).Offset(0, j).Value
                lignVER = lignVER + 1
            End If
            If Sheets("Feuil1").Range("A" & i).Offset(0, j).Value Like "ADV*" Then
                Sheets("Feuil2").Range("D1").Offset(lignADV, 0).Value = Sheets("Feuil1").Range("A" & i).Offset(0, j).Value
                lignADV = lignADV + 1
            End If
        Next
    Next
End Sub

Il gère seulement les cas PRO,DET,VER,ADV : il recopie les valeurs des cellules dans la deuxième feuille, en les classant par colonne. Cependant tu peux facilement finir le code, il suffit de rajouter à chaque fois une variable ligne (lignPRO,lignDET..) et de copier/coller le if suivant (et le mettre à la suite des autres) en remplaçant TEST par le début de ton expression, comme j'ai fait avec PRO,DET,etc.. :

VB: 
 If Sheets("Feuil1").Range("A" & i).Offset(0, j).Value Like "TEST*" Then
                'Décaler la colonne de 1 à chaque fois, ou même changer les colonnes selon tes envies
                Sheets("Feuil2").Range("C1").Offset(lignTEST, 0).Value = Sheets("Feuil1").Range("A" & i).Offset(0, j).Value
                lignTEST = lignTEST + 1
 End If

Bonne journée,
WUTED
 
Vote positif 0 Vote négatif
Re : [Excel] Comment trouver le contenu d'une cellule dans une ligne, puis la copier

Bonjour Kirko, bienvenue sur XLD, salut WUTED,

Cette macro dans le fichier joint :

Code: 
Sub Analyse()
Dim tablo, ub%, d As Object, i&, j%, p%, restit$(), col%
tablo = Feuil1.UsedRange 'Feuil1 => CodeName à adapter
ub = UBound(tablo, 2)
Set d = CreateObject("Scripting.Dictionary")
With Feuil2 'CodeName de la feuille de restitution, à adapter
  '---titres des colonnes, sans doublon---
  For i = 1 To UBound(tablo)
    For j = 1 To ub
      tablo(i, j) = Application.Trim(tablo(i, j)) 'SUPPRESPACE
      tablo(i, j) = Replace(tablo(i, j), "::", ":") 'pour PUN...
      p = InStrRev(tablo(i, j), ":")
      If p Then d(Left(tablo(i, j), p)) = Left(tablo(i, j), p)
    Next
  Next
  .Cells.ClearContents 'RAZ
  .[A1].Resize(, d.Count) = d.Items
  .[1:1].Sort .[1:1], Orientation:=xlLeftToRight 'tri
  '---analyse ligne par ligne---
  ReDim restit(1 To UBound(tablo), 1 To d.Count)
  For i = 1 To UBound(tablo)
    For j = 1 To ub
      p = InStrRev(tablo(i, j), ":")
      If p Then
        col = Application.Match(Left(tablo(i, j), p), .[1:1], 0)
        restit(i, col) = Mid(tablo(i, j), p + 1)
      End If
    Next
  Next
  .[A2].Resize(UBound(tablo), d.Count) = restit
  .Activate
End With
End Sub
L'analyse se fait ligne par ligne, mais on pourrait supprimer les cellules vides si nécessaire.

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Re : [Excel] Comment trouver le contenu d'une cellule dans une ligne, puis la copier

Re,

Si l'on veut supprimer les cellules vide, mettre ce code en fin de macro :

Code: 
On Error Resume Next 'si aucune cellule vide
.UsedRange.SpecialCells(xlCellTypeBlanks).Delete xlUp 'facultatif
Bien entendu on ne sait plus alors à quelle ligne un texte appartenait.

Fichier joint.

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Re : [Excel] Comment trouver le contenu d'une cellule dans une ligne, puis la copier

Re,

J'avais mal regardé le tableau !

Sur une même ligne, il peut y avoir plusieurs textes pour un même titre...

Alors je pense qu'il vaut mieux utiliser cette version :

Code: 
Sub Analyse()
Dim tablo, ub%, d As Object, i&, j%, p%, Nb&(), col%, restit$()
tablo = Feuil1.UsedRange 'Feuil1 => CodeName à adapter
ub = UBound(tablo, 2)
Set d = CreateObject("Scripting.Dictionary")
With Feuil2 'CodeName de la feuille de restitution, à adapter
  '---titres des colonnes, sans doublon---
  For i = 1 To UBound(tablo)
    For j = 1 To ub
      tablo(i, j) = Application.Trim(tablo(i, j)) 'SUPPRESPACE
      tablo(i, j) = Replace(tablo(i, j), "::", ":") 'pour PUN...
      p = InStrRev(tablo(i, j), ":")
      If p Then d(Left(tablo(i, j), p)) = Left(tablo(i, j), p)
    Next
  Next
  .Cells.ClearContents 'RAZ
  .[A1].Resize(, d.Count) = d.Items
  .[1:1].Sort .[1:1], Orientation:=xlLeftToRight 'tri
  '---analyse ligne par ligne---
  ReDim Nb(1 To d.Count)
  For i = 1 To UBound(tablo)
    For j = 1 To ub
      p = InStrRev(tablo(i, j), ":")
      If p Then
        col = Application.Match(Left(tablo(i, j), p), .[1:1], 0)
        Nb(col) = Nb(col) + 1
        ReDim Preserve restit(1 To d.Count, 1 To Application.Max(Nb))
        restit(col, Nb(col)) = Mid(tablo(i, j), p + 1)
      End If
    Next
  Next
  .[A2].Resize(Application.Max(Nb), d.Count) = Application.Transpose(restit)
  .Activate
End With
End Sub
Une contrainte : Application.Transpose n'accepte pas plus de 65536 lignes.

Fichier joint.

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Re : [Excel] Comment trouver le contenu d'une cellule dans une ligne, puis la copier

Re, pour terminer,

Si la restitution a plus de 65536 lignes, il faut transposer à la fin item par item :

Code: 
'---transposition et restitution---
ReDim Tr(1 To Application.Max(Nb), 1 To d.Count)
ub = UBound(Tr, 2)
For i = 1 To UBound(Tr)
  For j = 1 To ub
    Tr(i, j) = restit(j, i)
  Next
Next
.[A2].Resize(UBound(Tr), ub) = Tr
Fichier (2).

Edit : j'ai testé les 2 versions sur un tableau de 36600 lignes avec Win XP/Excel 2003.

Curieusement cette version (2) est un peu plus rapide : 35,6 s au lieu de 37,6 s.

A+
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Re : [Excel] Comment trouver le contenu d'une cellule dans une ligne, puis la copier

Merci infiniment Wuted et Job 75, je sais pas comment vous avez fabriqué ça, mais vous êtes très franchement impressionnant !

Job75, le post que j'i quoté, c'est celui qui correspond le mieux à ce que je recherchais (qui correspond à 100% en fait) car par rapport proposition suivantes, celle-ci garde les caractéristiques de chaque ligne et ne mélange pas toutes les données.(il faut prendre les données de chaque ligne comme les caractéristiques d'une personne, donc dissociable.)


J'aurais bien aimé demandé des explication sur la façon de faire, mais j'imagine que ça doit être du codage particulierment compliqué et du coup je me contente de te dire un très grand merci. J'imagine qu'avec les formules classiques, je n'aurais jamais pu avoir un tel résultat ....

job75 à dit:
Bonjour Kirko, bienvenue sur XLD, salut WUTED,

Cette macro dans le fichier joint :

Code: 
Sub Analyse()
Dim tablo, ub%, d As Object, i&, j%, p%, restit$(), col%
tablo = Feuil1.UsedRange 'Feuil1 => CodeName à adapter
ub = UBound(tablo, 2)
Set d = CreateObject("Scripting.Dictionary")
With Feuil2 'CodeName de la feuille de restitution, à adapter
  '---titres des colonnes, sans doublon---
  For i = 1 To UBound(tablo)
    For j = 1 To ub
      tablo(i, j) = Application.Trim(tablo(i, j)) 'SUPPRESPACE
      tablo(i, j) = Replace(tablo(i, j), "::", ":") 'pour PUN...
      p = InStrRev(tablo(i, j), ":")
      If p Then d(Left(tablo(i, j), p)) = Left(tablo(i, j), p)
    Next
  Next
  .Cells.ClearContents 'RAZ
  .[A1].Resize(, d.Count) = d.Items
  .[1:1].Sort .[1:1], Orientation:=xlLeftToRight 'tri
  '---analyse ligne par ligne---
  ReDim restit(1 To UBound(tablo), 1 To d.Count)
  For i = 1 To UBound(tablo)
    For j = 1 To ub
      p = InStrRev(tablo(i, j), ":")
      If p Then
        col = Application.Match(Left(tablo(i, j), p), .[1:1], 0)
        restit(i, col) = Mid(tablo(i, j), p + 1)
      End If
    Next
  Next
  .[A2].Resize(UBound(tablo), d.Count) = restit
  .Activate
End With
End Sub
L'analyse se fait ligne par ligne, mais on pourrait supprimer les cellules vides si nécessaire.

A+
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
Re : [Excel] Comment trouver le contenu d'une cellule dans une ligne, puis la copier

Bonjour Kirko,

Je m'étais douté que vous souhaiteriez pouvoir repérer les caractéristiques de chaque ligne.

Alors voici la 1ère version améliorée :

Code: 
Sub Analyse()
Dim tablo, ub%, d As Object, i&, j%, p%, restit$(), col%
tablo = Feuil1.UsedRange 'Feuil1 => CodeName à adapter
ub = UBound(tablo, 2)
Set d = CreateObject("Scripting.Dictionary")
With Feuil2 'CodeName de la feuille de restitution, à adapter
  '---initialisation---
  .Cells.Delete
  .[1:1].Font.Bold = True 'gras
  .[1:1].Font.ColorIndex = 5 'bleu
  '---titres des colonnes, sans doublon---
  For i = 1 To UBound(tablo)
    For j = 1 To ub
      tablo(i, j) = Trim(tablo(i, j)) 'des titres sont précédés d'espaces...
      tablo(i, j) = Replace(tablo(i, j), "::", ":") 'pour PUN...
      p = InStrRev(tablo(i, j), ":")
      If p Then d(Left(tablo(i, j), p)) = Left(tablo(i, j), p)
    Next
  Next
  .[A1].Resize(, d.Count) = d.Items
  .[1:1].Sort .[A1], Orientation:=xlLeftToRight 'tri
  '---analyse ligne par ligne---
  ReDim restit(1 To UBound(tablo), 1 To d.Count)
  For i = 1 To UBound(tablo)
    For j = 1 To ub
      p = InStrRev(tablo(i, j), ":")
      If p Then
        col = Application.Match(Left(tablo(i, j), p), .[1:1], 0)
        restit(i, col) = restit(i, col) & IIf(restit(i, col) = "", "", vbLf) & Mid(tablo(i, j), p + 1)
      End If
    Next
  Next
  '---restitution---
  .[A2].Resize(UBound(tablo), d.Count) = restit
  .UsedRange.Columns.AutoFit 'ajustement de la largeur des colonnes
  .Activate
End With
End Sub
Quand sur une même ligne il y a plusieurs textes pour un même titre, ils sont concaténés avec un saut de ligne (vbLf) comme séparateur.

Fichier (2).

A+
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

DAVID-44-
  • Question Question
Microsoft 365 Effacer (et non supprimer) une ligne suivant texte.
Réponses
6
Affichages
123
DAVID-44-
DAVID-44-
S
  • Résolu(e)
XL 2013 Copier-Coller une ligne dans tableau variable, et la manipuler.
Réponses
4
Affichages
175
StéphaneDeLà
S
S
  • Résolu(e)
Microsoft 365 Reporter le contenu d'une plage dans une cellule selon un ordre précis
Réponses
4
Affichages
298
sebastien176
S
W
  • Question Question
XL 2019 Changer la graisse et la taille avant le deuxième retour à la ligne dans une cellule
Réponses
6
Affichages
123
Webperegrino
W
A
  • Résolu(e)
XL 2016 Recherche d'un mot dans une cellule et surlignage de la ligne
Réponses
4
Affichages
215
Abi23
A
F
  • Question Question
Autres Récupération de données d'une feuille X en fonction de la valeur de cellule dans une collone d'une feuille Y
2
Réponses
27
Affichages
924
fanfan38
fanfan38
C
  • Question Question
XL 2021 Comment intégrer le contenu d'une cellule dans une formule
Réponses
1
Affichages
370
chris
chris
S
  • Résolu(e)
XL 2016 Copier/Coller des cellules en multipliant par des cellules sur une autre page
Réponses
3
Affichages
709
migau
migau
Lu76Fer
  • Question Question
XL 2016 XLS - Comment déterminer les zones présentent au niveau d'une cellule ?
Réponses
2
Affichages
199
Lu76Fer
Lu76Fer
C
  • Question Question
Microsoft 365 je cherche un code excel pour copier la couleur d'une cellule, à toutes les cellules qui ont la même valeur dans mon tableau.
Réponses
1
Affichages
300
sylvanu
sylvanu
G
  • Question Question
Microsoft 365 Saut de ligne dans une cellule
Réponses
3
Affichages
582
GClaire
G
M
  • Question Question
XL 2021 Copier une cellule sur deux et coller dans une autre colonne
Réponses
5
Affichages
523
DJunqueira
D
J
  • Résolu(e)
XL 2019 Détection de texte dans une Cellule pour le Copier et Coller dans un autre tableau
2 3
Réponses
40
Affichages
2 K
Phil69970
Phil69970
A
  • Question Question
Insérer un copier / coller
Réponses
0
Affichages
343
aziz
A
jeff1494
  • Question Question
XL 2021 Orientation d'une image dans le commentaire d'une cellule
2 3
Réponses
42
Affichages
2 K
AtTheOne
AtTheOne
T
  • Résolu(e)
Microsoft 365 Insérer une image DANS une cellule
Réponses
12
Affichages
1 K
Thomi
T
M
  • Question Question
XL 2019 Copier des lignes les unes a la suite des autres dans une autre feuille sous conditions et seulement certaines colonnes
Réponses
7
Affichages
770
MGH
M
N
  • Question Question
Microsoft 365 afficher/masquer des lignes en fonction de la valeur d'une cellule qui aura été renseignée par une autre feuille (via un copier/collé automatique)
Réponses
5
Affichages
668
Nel'
N
N
  • Résolu(e)
Microsoft 365 Rechercher la dernière cellule saisie dans un TS et ajouter l'heure système
18 19 20
Réponses
297
Affichages
69 K
NONO14
N
M
  • Question Question
XL 2021 Copier coller les valeur d'une ligne si la case contiens "x"
Réponses
2
Affichages
602
manga419
M
Retour