Rechercher et extraire des valeurs de plusieurs cellules

[nephtys38]

Bonjour,

Je souhaite rechercher et extraire des valeurs de cellules qui ont une structure d'emails (*@*), sachant que les emails peuvent se trouver sur différentes lignes et colonnes, et parfois a plusieurs reprises.
En gros j'aimerais juste une options supplémentaire à la fonctionnalité inclue dans Excel "Rechercher et remplacer" qui me permette d'extraire les valeurs des cellules trouvées par "Rechercher tout" dans une nouvelle feuille.

Merci de votre aide !

 

[Efgé]

Re : Rechercher et extraire des valeurs de plusieurs cellules

Bonjour nephtys38, et bienvenue sur le forum,
Je ne sais pas si je pourrai t'aider, mais il serait quand même préférable de nous joindre un petit classeur exemple, sans do,,ées confidentielles et de moins de 50 Ko.
Cela nous permetrait de voir la structure de ton fichier.
Cordialement

EDIT J'oubliais; au format .xls

 

[nephtys38]

Re : Rechercher et extraire des valeurs de plusieurs cellules

Voilà un exemple.
Je souhaite récupérer la colonne 'valeur' de la fonctionnalité recherche.

Merci

 

[Efgé]

Re : Rechercher et extraire des valeurs de plusieurs cellules

Re
Je n'ai pas pu ouvrir ton fichier, je suis sous 2003, mais je te fait une proposition:
Sur la feuille 2 : La liste sans doublon des mails en colonne A et le nombre de fois où ce mail est présent en colonne B.

Sub Mail()
Plg = Sheets("Feuil1").UsedRange.Value
Set Dico = CreateObject("Scripting.Dictionary")
For i = LBound(Plg, 1) To UBound(Plg, 1)
    For j = LBound(Plg, 2) To UBound(Plg, 2)
        If Plg(i, j) Like "*@*" Then
               Dico(Plg(i, j)) = Dico(Plg(i, j)) + 1
        End If
    Next j
Next i
With Sheets("Feuil2")
    .Cells(1, 1).Resize(Dico.Count, 1) = Application.Transpose(Dico.Keys)
    .Cells(1, 2).Resize(Dico.Count, 1) = Application.Transpose(Dico.Items)
    .Activate
End With
End Sub

Cordialement

 

[nephtys38]

Re : Rechercher et extraire des valeurs de plusieurs cellules

Merci Efgé,
Cela marche sur l'exemple mais j'ai une erreur "incompatibilité de type" sur mon autre fichier, je ne vois pas d'où cela peut provenir...

 

[Efgé]

Re : Rechercher et extraire des valeurs de plusieurs cellules

Re
J'imagine que tu as des cellules avec des formules en erreurs.
Si c'est le cas utilise ceci:

Sub Mail()
Plg = Sheets("Feuil1").UsedRange.Value
Set Dico = CreateObject("Scripting.Dictionary")
For i = LBound(Plg, 1) To UBound(Plg, 1)
    For j = LBound(Plg, 2) To UBound(Plg, 2)
        If Not IsError(Plg(i, j)) Then
            If Plg(i, j) Like "*@*" Then
                   Dico(Plg(i, j)) = Dico(Plg(i, j)) + 1
            End If
        End If
    Next j
Next i
With Sheets("Feuil2")
    .Columns("A:B").ClearContents
    .Cells(1, 1).Resize(Dico.Count, 1) = Application.Transpose(Dico.Keys)
    .Cells(1, 2).Resize(Dico.Count, 1) = Application.Transpose(Dico.Items)
    .Activate
End With
End Sub

Cordialement

 

[nephtys38]

Re : Rechercher et extraire des valeurs de plusieurs cellules

Super ça marche, j'ai supprimé les = et + du document et utilisé la première macro car la 2nde me renvoyait une erreur.

Merci beaucoup!