Recherche des cellules sur une feuille excel

Lachmacros

XLDnaute Nouveau
Bonjour,
Je suis un débutant en VBA et je souhaite avoir votre aide pour une éventuelle Macro.
J'ai un fichier qui effectue une extraction des fichiers .txt.
Après extraction, je veux garder quelques informations qui sont caractérisés par des crochets exemple:([infos1]).
Cela dit j'ai besoin d'une macro qui effectue une recherche sur toutes les cellules de la feuille, si elle trouve l'information désirable elle la garde et copie le résultat à la première colonne de la même feuille sinon elle supprime le reste.
Je ne veux pas faire un filtre, car ce dernier tri les infos sur une seule colonne.
Ce fichier contient deux feuille
- la première: les données extraites du fichier .txt et les infos que je souhaite récupérer (colorée en jaune).
- la deuxième: le résultat que je veux l'avoir.
Merci de votre aide.
 

Pièces jointes

  • Doc.xlsx
    10.5 KB · Affichages: 35
  • Doc.xlsx
    10.5 KB · Affichages: 33
  • Doc.xlsx
    10.5 KB · Affichages: 34
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re : Recherche des cellules sur une feuille excel

Bonsoir à tous

Lachmacros [Bienvenue sur le forum]
Dans un premier, on peut trier
Code:
Sub TriLeftToRight()
Dim i As Long
Application.ScreenUpdating = False
For i = 15 To 115
Cells(i, "A").Resize(, 20).Sort Key1:=Cells(i, "A").Resize(, 30), Order1:=xlAscending, Orientation:=xlLeftToRight
Next
Application.ScreenUpdating = True
End Sub
Et ensuite on peut filtrer puis copier
01LMFiltre.png

J'attends de voir si cette piste te tente pour aller plus loin ;)
 

Lachmacros

XLDnaute Nouveau
Re : Recherche des cellules sur une feuille excel

Bonsoir Staple1600,
J'ai commencé par cette idée mais je l'ai très vite abandonné parce qu'il y a des fichiers extraits plus complexes.
Je veux une macro qui effectue la recherche automatique de toutes les cellules de la feuille active, dans le but d'extraire les infos de type ([infos]), ainsi de les classés sur une seule colonne
prenant le cas de ce fichier qui a des données plus difficile à extraire.

Merci de ton aide
 

Pièces jointes

  • Doc.xlsx
    10.5 KB · Affichages: 29
  • Doc.xlsx
    10.5 KB · Affichages: 30
  • Doc.xlsx
    10.5 KB · Affichages: 29
Dernière édition:

DoubleZero

XLDnaute Barbatruc
Re : Recherche des cellules sur une feuille excel

Bonjour, Lachmacros, Staple1600 :), le Forum,

Peut-être ainsi :

VB:
Option Explicit
Sub Valeur_entre_crochets_lister()
    Dim c As Range
    With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
    Columns(1).Clear
    For Each c In ActiveSheet.UsedRange
        If Left(c, 1) = "[" Then
            c.Cut Destination:=Range("a" & Rows.Count).End(xlUp)(2)
        Else
            c.Clear
        End If
    Next
    [a1] = "Résultat"
    ActiveSheet.Range("a:a").Sort Range("a1"), xlAscending, Header:=xlYes
    Columns(1).AutoFit
    With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
End Sub

A bientôt :)
 

Lachmacros

XLDnaute Nouveau
Re : Recherche des cellules sur une feuille excel

Bonjour le Forum,
Merci DoubleZero; ton code fonctionne à merveille:).
J'ai inséré une colonne, en vue que sur certain fichiers, les données recherchées sont classées à la première colonne.
Juste avec certains fichiers j'ai eu un bug, la macro arrive à extraire les données et les classer sur la première colonne mais elle ne termine pas l'exécution tout en affichant une erreur de type
"erreur d'exécution "13" Incompatibilité de type"
Merci de ton aide.
 

DoubleZero

XLDnaute Barbatruc
Re : Recherche des cellules sur une feuille excel

Re-bonjour,

... Juste avec certains fichiers j'ai eu un bug, la macro arrive à extraire les données et les classer sur la première colonne mais elle ne termine pas l'exécution tout en affichant une erreur de type
"erreur d'exécution "13" Incompatibilité de type"...

Merci de bien vouloir déposer un exemple de fichier, sans donnée confidentielle, dans lequel l'erreur se produit.

A bientôt :)
 

Lachmacros

XLDnaute Nouveau
Re : Recherche des cellules sur une feuille excel

Bonjour,
Alors j'ai réussi à trouver la source du problème, c'est avec l'extraction des données d'un doc.txt vers une feuille excel, certaines cellules contiennent au début de leur texte la formule "=", automatiquement elles deviennent des formules, dès que la macro atteint ces cellules elle bloque.
est ce que c'est possible d'ajouter une commande qui permet d'effacer ces cellules avant le lancement de la recherche.
ci-joint un exemple contenant des cellules qui causent le bug
Merci bcp de ton aide.
 

Pièces jointes

  • Doc.xlsx
    10 KB · Affichages: 30
  • Doc.xlsx
    10 KB · Affichages: 32
  • Doc.xlsx
    10 KB · Affichages: 27

Lachmacros

XLDnaute Nouveau
Re : Recherche des cellules sur une feuille excel

j'ai trouver une solution en remplaçant les formules "=" par "-"
le code fonctionne parfaitement :
Code:
Sub Valeur_entre_crochets_lister()
     Dim c As Range    
     Cells.Select
     Selection.Replace What:="=", Replacement:="-", LookAt:=xlPart, _
     SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
     ReplaceFormat:=False    
     With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
     Columns("a:a").Select
     Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
     Columns(1).Clear
     For Each c In ActiveSheet.UsedRange
         If Left(c, 1) = "[" Then
             c.Cut Destination:=Range("a" & Rows.Count).End(xlUp)(2)
         Else
             c.Clear
         End If  
     Next
     [a1] = "Marqueurs"
     ActiveSheet.Range("a:a").Sort Range("a1"), xlAscending, Header:=xlYes
     Columns(1).AutoFit
     With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
     ActiveSheet.Range("$A$1:$A$1127").RemoveDuplicates Columns:=1, Header:=xlNo
End Sub
Merci beaucoup pour ton aide
 

DoubleZero

XLDnaute Barbatruc
Re : Recherche des cellules sur une feuille excel

Re-bonjour,

j'ai trouver une solution en remplaçant les formules "=" par "-"
le code fonctionne parfaitement...

Merci pour ce retour et bravo :D pour la solution trouvée.

Si je peux me permettre quelques commentaires bienveillants :

VB:
Sub Valeur_entre_crochets_lister_Lachmacros()
    Dim c As Range
    Cells.Select
    Selection.Replace What:="=", Replacement:="-", LookAt:=xlPart, _
                      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                      ReplaceFormat:=False
    'la ligne ci-dessous doit être placée après la déclaration de(s) variable(s)
    With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
    Columns("a:a").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    'il est inutile de supprimer les valeurs de la colonne 1 puisqu'elle vient d'être insérée et ne contient aucune valeur
    Columns(1).Clear
    For Each c In ActiveSheet.UsedRange
        If Left(c, 1) = "[" Then
            c.Cut Destination:=Range("a" & Rows.Count).End(xlUp)(2)
        Else
            c.Clear
        End If
    Next
    [a1] = "Marqueurs"
    ActiveSheet.Range("a:a").Sort Range("a1"), xlAscending, Header:=xlYes
    Columns(1).AutoFit
    'la ligne ci-dessous doit être placée avant End Sub
    With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
    'les doublons inscrits à partir de la cellule a1127 sont ignorés...
    ActiveSheet.Range("$A$1:$A$1127").RemoveDuplicates Columns:=1, Header:=xlNo
End Sub

Nouvelle suggestion :

VB:
Option Explicit
Sub Valeur_entre_crochets_lister_V2_DoubleZero()
    Dim c As Range
    With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
    Columns(1).Insert
    ' si l'onglet ne contient aucune formule
    On Error Resume Next
    Cells.SpecialCells(xlCellTypeFormulas, 23).Clear
    For Each c In Cells.SpecialCells(xlCellTypeConstants, 23)
        If Left(c, 1) = "[" Then
            c.Cut Destination:=Range("a" & Rows.Count).End(xlUp)(2)
        Else
            c.Clear
        End If
    Next
    [a1] = "Marqueurs"
    Columns(1).RemoveDuplicates Columns:=1, Header:=xlYes
    Range("a:a").Sort Range("a1"), xlAscending, Header:=xlYes
    Columns(1).AutoFit
    With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
End Sub

Les membres émérites :D du code trouveront certainement des améliorations.

A bientôt :)
 

Lachmacros

XLDnaute Nouveau
Re : Recherche des cellules sur une feuille excel

Merci BCPPPPPPPPPP:D
c'est plus simple et rapide!!
une autre question concernant les données recherchées ; une info correspond au critère de sélection ex: "[IM]", du coup j'ai essayé d'utiliser l'instruction suivante:
Code:
Selection.Replace What:="[IM]", Replacement:="-", LookAt:=xlPart, _
     SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
     ReplaceFormat:=False
tu penses quoi?
- j'ai aussi une petite anomalie concernant le critère de recherche ; des fois il affiche tout le contenu de la cellules ex: [infos]:;://"
- il y a aussi des informations positionnées juste après un mot ou un autre caractère ex: "aaaaa[infos]bbb", celles-ci ne sont pas prises en compte.
Ci joint le fichier Docc.xlsx pour mieux appréhender les cas rencontrés

Je te remercie infiniment, ton aide est vraiment précieuse :)
 

Pièces jointes

  • Docc.xlsx
    10.9 KB · Affichages: 36

DoubleZero

XLDnaute Barbatruc
Re : Recherche des cellules sur une feuille excel

Bonjour, Lachmacros, Staple1600 :), le Forum,

Alors comme ceci ?

VB:
Option Explicit
Sub Valeur_entre_crochets_lister_V3_DoubleZero()
    Dim c As Range
    With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
    Columns(1).Insert
    On Error Resume Next
    Cells.SpecialCells(xlCellTypeFormulas, 23).Clear
    For Each c In Cells.SpecialCells(xlCellTypeConstants, 23)
        If c.Value Like "*[]*" Then
            c.Cut Destination:=Range("a" & Rows.Count).End(xlUp)(2)
        End If
    Next
    With Cells
        .Replace What:="*[", Replacement:="["
        .Replace What:="]*", Replacement:="]"
    End With
    [a1] = "Marqueurs"
    Columns(1).RemoveDuplicates Columns:=1, Header:=xlYes
    Range("a:a").Sort Range("a1"), xlAscending, Header:=xlYes
    Columns(1).AutoFit
    With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
End Sub

A bientôt :)
 

Lachmacros

XLDnaute Nouveau
Re : Recherche des cellules sur une feuille excel

Re-bonjour,

ce perfectionnement à apporter qlq changement.
la recherche est plus précise mais le résultats est différent, je ne sais pas pourquoi mais il est entrain de récupérer toutes les données qui commence commençant par d'autres types de caractères et mêmes des lettres.
j'ai essayer de changer le critère de sélection sans résultat.
je t'ai mis un exemple en pièce jointe .
Merci :) c'est vraiment très gentil de ta part
 

Pièces jointes

  • Doc.xlsx
    10 KB · Affichages: 31
  • Doc.xlsx
    10 KB · Affichages: 27
  • Doc.xlsx
    10 KB · Affichages: 31

DoubleZero

XLDnaute Barbatruc
Re : Recherche des cellules sur une feuille excel

Bonjour à toutes et à tous,

...la recherche est plus précise mais le résultats est différent...

Un autre essai avec le présent code :

VB:
Option Explicit
Sub Valeur_entre_crochets_lister_V4()
    Dim c As Range
    With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
    Columns(1).Insert
    On Error Resume Next
    With Cells
        .SpecialCells(xlCellTypeFormulas, 23).Clear
        .Replace What:="*[", Replacement:="["
        .Replace What:="]*", Replacement:="]"
    End With
    For Each c In ActiveSheet.UsedRange
        If Left(c, 1) <> "[" Then
            c.Clear
        Else
            c.Cut Destination:=Range("a" & Rows.Count).End(xlUp)(2)
        End If
    Next
    [a1] = "Marqueurs"
    With Columns(1)
        .RemoveDuplicates Columns:=1, Header:=xlYes
        .Sort Range("a1"), xlAscending, Header:=xlYes
        .AutoFit
    End With
    With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
End Sub

A bientôt :)
 

Discussions similaires

Statistiques des forums

Discussions
312 497
Messages
2 088 985
Membres
103 998
dernier inscrit
Gotteland