boucle sur un find

Version imprimable

boucle sur un find

Bonjour,

Je cherche à tester la présence d'une adresse mail contenue dans une chaine de caractère. Les chaines de caractères sont dans une colonne.Si l'adresse mail est présente je voudrai la transférer dans une nouvelle colonne. J'ai commencé en utilisant range.Find() pour mettre la chaine dans un tableau. Mon probleme est ensuite de faire une boucle pour tester toute la colonne. Est ce que c'est la bonne façon de procéder?
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Sub chercheMot() Dim Tableau() As String Dim cell As Range Set cell = Columns("B:B").Find(What:="connexion") If Not cell Is Nothing Then Tableau = Split(cell, ":") End If End Sub

04/04/2017, 20h42
parmi

Bonjour,

La méthode que tu utilises est correcte pour rechercher une valeur une seule fois dans une colonne.
Tu pourrais ajouter les paramètres LookIn:=xlValues (valeur recherchée dans le texte de la cellule et pas la formule) et LookAt:=xlPart
xlPart si la valeur que tu recherches est une partie de la cellule visée, autrement xlWhole si la valeur = exactement le contenu de la cellule.

Si, par contre, tu veux rechercher plusieurs cellules contenant un certain terme, il faut ajouter un FindNext dans une boucle pour poursuivre la recherche.
Tu peux voir un bon exemple dans l'aide.

Merci!

Je suis finalement passé par quelquechose de plus adapté. Il faut juste que je mette une plage sous forme de variable. Je compte parser les éléments du tableau à la recherche de l'adresse mail. Est ce qu'il y a une methode plus fine?
Code:

1 2 3 4 5 6 7 8 9 10 11 Sub chercheMot() Dim Tableau() As String For Each cellule In [B1:B5] If cellule Like "*connexion*" Then Tableau = Split(cellule, ":") End If Next For i = 0 To UBound(Tableau) Debug.Print Tableau(i) Next i End Sub

04/04/2017, 22h53
parmi

Sans connaître le genre de valeurs que tu recherches/lis et le nombre de lignes que tu dois parcourir, c'est difficile à dire

1 pièce(s) jointe(s)

parmi, j'ai mis un exemple en pièce jointe. J'ai modifié le code. Je n'arrive pas à me débarrasser de la chaine "Numero de téléphone".

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub chercheMot()
'recuperation adresse mail et copie dans la cellule à droite
    Dim Tableau() As String
    For Each cellule In Range([B1], Cells(Rows.Count, 1).End(xlUp))
        If cellule Like "*contact*" Then 'recherche du mot "contact"
            Tableau = Split(cellule, ":")
            For Each valeur In Tableau 'les fragments sont mis dans un tableau
                If valeur Like "*@*" Then
                    cellule.Offset(0, 1).Value = valeur 'si une chaine contient "@" elle est placé à droite de la cellule
                End If
            Next
        End If
    Next
    For i = 0 To UBound(Tableau)
        Debug.Print Tableau(i)
    Next i
 End Sub

05/04/2017, 17h02
Marc-L

Bonjour !

Citation:

Envoyé par loncle

Est ce que c'est la bonne façon de procéder?

La méthode Find est un bon choix et il suffit pourtant de l'utiliser comme dans l'exemple de l'aide VBA interne !
Aide VBA à ouvrir donc, sans modération, autant de fois que nécessaire …

___________________________________________________________________________________________________________
Je suis Paris, London, Istanbul, Berlin, Nice, Bruxelles, Charlie, …

À partir de ta première approche, essaie ceci

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub chercheMot()
'recuperation adresse mail et copie dans la cellule à droite
    Dim Tableau() As String, Tablo
    For Each cellule In Range([B1], Cells(Rows.Count, 1).End(xlUp))
        If cellule Like "*contact*" Then 'recherche du mot "contact"
            Tablo = Split(cellule, vbLf)  'Split sur les sauts de ligne
            For i = 0 To UBound(Tablo)
                Tableau = Split(Tablo(i), ":")
                For Each valeur In Tableau 'les fragments sont mis dans un tableau
                    If valeur Like "*@*" Then
                        cellule.Offset(0, 1).Value = Trim(valeur) 'si une chaine contient "@" elle est placé à droite de la cellule
                    End If
                Next
            Next
        End If
    Next
    For i = 0 To UBound(Tableau)
        Debug.Print Tableau(i)
    Next i
 End Sub

Merci parmi. J'ai essayé avec Find et FindNext.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub chercheMot()
    Dim Tableau() As String
    Dim cell As Range
    Set cell = Columns("B:B").Find(What:="contact")
    premAdress = cell.Address
    Do
        Tableau = Split(cell, ":")
        For Each valeur In Tableau
            If valeur Like "*@*" Then
                cell.Offset(0, 1).Value = Trim(valeur)
            End If
        Next
        Set cell = Columns("B:B").FindNext(cell)
    Loop While cell.Address <> premAdress
End Sub