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

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

  • Nouveau Feuille Microsoft Office Excel.xlsx
    27.1 KB · Affichages: 77
  • Nouveau Feuille Microsoft Office Excel.xlsx
    27.1 KB · Affichages: 83
  • Nouveau Feuille Microsoft Office Excel.xlsx
    27.1 KB · Affichages: 79
Trier par date Trier par votes
WUTED

WUTED

XLDnaute Occasionnel
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
job75

job75

XLDnaute Barbatruc
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

  • Analyse(1).xls
    107.5 KB · Affichages: 84
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
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

  • Analyse et suppression des cellules vides(1).xls
    107.5 KB · Affichages: 74
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
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

  • Analyse séquentielle(1).xls
    108 KB · Affichages: 57
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
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

  • Analyse séquentielle(2).xls
    109 KB · Affichages: 68
Dernière édition:
Vote positif 0 Vote négatif
K

Kirko

XLDnaute Nouveau
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
job75

job75

XLDnaute Barbatruc
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

  • Analyse(2).xls
    105.5 KB · Affichages: 65
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

A
  • Question
Insérer un copier / coller
Réponses
0
Affichages
181
aziz
A
C
  • Question
XL 2021 Comment intégrer le contenu d'une cellule dans une formule
Réponses
1
Affichages
101
chris
chris
M
  • Question
XL 2021 Copier une cellule sur deux et coller dans une autre colonne
Réponses
5
Affichages
176
DJunqueira
D
C
  • Question
XL 2013 faire une formule sous Excel 2013 pour copier les mises en forme d'une autre cellule
Réponses
4
Affichages
233
cd92600
C
Q
  • Question
XL 2019 copier une ligne en fonction de la valeur d'une cellule
Réponses
10
Affichages
667
quetzal974
Q
M
  • Question
XL 2021 Copier coller les valeur d'une ligne si la case contiens "x"
Réponses
2
Affichages
396
manga419
M
G
  • Question
XL 2010 Copier coller une image dans le corps de message via gmail
Réponses
8
Affichages
384
gwenn49
G
13Hubert
  • Résolu(e)
Microsoft 365 VBA - Comment chercher, trouver et renseigner dans une variable, la plus grande valeur d'une colonne ?
Réponses
2
Affichages
226
13Hubert
13Hubert
N
  • Résolu(e)
XL 2021 copier ligne vers une feuille existante sous condition et supprimer ligne de la feuille d'origine
Réponses
9
Affichages
426
NicolasKH
N
F
  • Question
XL 2016 copier des fichiers dans des sous dossiers a partir de case a cocher sous excel
2
Réponses
17
Affichages
548
Felipe54
F

Membres actuellement en ligne

14 membres et 261 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 198
Messages
2 086 114
Membres
103 121
dernier inscrit
SophieS