Discussion :

[Sebphyto]

Bonjour le Forum,

Suite à des requêtes environ 10/jours , l'importation se fait dans la "feuille 4", j'ai besoin de rechercher dans cette feuille, 1 mot à chaque fois qui par la suite est consigné dans une autre feuille ( la 2).

La recherche se fait toujours sur les mêmes mots (mot1, mot2, mot3, mot4, etc.... au nombre de 6 mots), grosso-modo je n'arrive pas à lui faire dire:

Si le mot1 n'est pas trouvé, alors chercher le deuxième, si pas trouvé alors le 3ème et s'il le trouve, l'inscrire le contenu de la cellule dans la feuille 2 en cellule B2 (par ex).

Voici un bout de code mais seulement pour un mot:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub Cherche()
Dim c As Range, strAdd As String, Plage As Range
 
Set Plage = Sheets("Requête").UsedRange
 
Set c = Plage.Find(What:="mot1")
If Not c Is Nothing Then
    strAdd = c.Address
    Do
         '<-- Adéfinir = l'endroit où se trouve la Feuille de destination + cellule
        Set c = Plage.FindNext(c)
    Loop While Not c Is Nothing And c.Address <> strAdd
End If
 
End Sub

Merci pour votre aide

Seb

[Invité]

Bonjour,

Une solution possible dans le code ci-dessous.

- La macro s'arrête au premier mot trouvé parmi les 6.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
 
Sub Cherche()
 
Dim c As Range, Plage As Range
 
Dim MotsRecherches As Variant
Dim I As Integer
Dim ShCible As Worksheet
Dim LigneFeuilleCible As Long
 
    Set ShCible = Sheets("Feuil2")
    LigneFeuilleCible = 2
    MotsRecherches = Array("Mot1", "Mot2", "Mot3", "Mot4", "Mot5", "Mot6")
 
    Set Plage = Sheets("Requête").UsedRange
 
    With ShCible
         For I = LBound(MotsRecherches, 1) To UBound(MotsRecherches, 1)
             Set c = Plage.Find(What:=MotsRecherches(I), LookAt:=xlWhole)  ' xlWhole : pour recherche sur l'ensemble du contenu de la cellule
             If Not c Is Nothing Then
                .Cells(LigneFeuilleCible, 2) = c
                .Cells(LigneFeuilleCible, 3) = c.Address
                Exit For
             End If
             Set c = Nothing
         Next I
     End With
 
     Set Plage = Nothing
 
End Sub

Cordialement.

[Sebphyto]

Bonjour Eric,

Belle approche, merci

Cela correspond à ma demande

Cette procédure doit être incorporé à une autre procédure de requête web (environ 8/ jours) et les résultats sont consignés dans une Bdd

Ici avec ce code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
.....
LigneFeuilleCible = 2
.....
Cells(LigneFeuilleCible, 2) = c
                .Cells(LigneFeuilleCible, 3) = c.Address

Il inscrira toujours la recherche en B2, comment écrire le code si je veux que pour chaque requête il passe à la ligne suivante?

MErci encore

[Invité]

Si la macro Cherche est appliquée à chaque extraction, il faut seulement incrémenter la dernière ligne de la colonne B de la feuille cible :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Sub Cherche()
 
Dim c As Range, Plage As Range
 
Dim MotsRecherches As Variant
Dim I As Integer
Dim ShCible As Worksheet
Dim LigneFeuilleCible As Long
 
    Set ShCible = Sheets("Feuil2")
    MotsRecherches = Array("Mot1", "Mot2", "Mot3", "Mot4", "Mot5", "Mot6")
 
    Set Plage = Sheets("Requête").UsedRange
 
    With ShCible
         LigneFeuilleCible = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
         For I = LBound(MotsRecherches, 1) To UBound(MotsRecherches, 1)
             Set c = Plage.Find(What:=MotsRecherches(I), LookAt:=xlWhole)  ' xlWhole : pour recherche sur l'ensemble du contenu de la cellule
             If Not c Is Nothing Then
                .Cells(LigneFeuilleCible, 2) = c
                .Cells(LigneFeuilleCible, 3) = c.Address
                Exit For
             End If
             Set c = Nothing
         Next I
     End With
 
     Set Plage = Nothing
 
End Sub

Cordialement.

[Sebphyto]

Re,

C'est parfait, je ne pense pas encore à tous dans ce dédale qu'est VBA.....Merci beaucoup

Mon sujet est résolu

A+
Sébastien

[Sebphyto]

re,

J'ai un message d'erreur ici:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

LigneFeuilleCible = .Cells(.Rows.Count, 2).End(xlUp).Row + 1

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.Rows

Erreur de compilation
référence non qualifiée ou incorrecte

Encore une petite sollicitation

Seb

[Invité]

Chez moi, je n'ai pas ce problème. As-tu touché au code transmis ?

J'ai seulement omis de supprimer la variable ShCible. Voir la fin du code.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub Cherche()
 
Dim c As Range, Plage As Range
 
Dim MotsRecherches As Variant
Dim I As Integer
Dim ShCible As Worksheet
Dim LigneFeuilleCible As Long
 
    Set ShCible = Sheets("Feuil2")
    MotsRecherches = Array("Mot1", "Mot2", "Mot3", "Mot4", "Mot5", "Mot6")
 
    Set Plage = Sheets("Requête").UsedRange
 
    With ShCible
         LigneFeuilleCible = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
         For I = LBound(MotsRecherches, 1) To UBound(MotsRecherches, 1)
             Set c = Plage.Find(What:=MotsRecherches(I), LookAt:=xlWhole)  ' xlWhole : pour recherche sur l'ensemble du contenu de la cellule
             If Not c Is Nothing Then
                .Cells(LigneFeuilleCible, 2) = c
                .Cells(LigneFeuilleCible, 3) = c.Address
                Exit For
             End If
             Set c = Nothing
         Next I
     End With
 
     Set Plage = Nothing
     Set ShCible = Nothing
 
 End Sub

Cordialement.

D'où vient

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.Rows

?

Cordialement.

[Sebphyto]

Re,

Non je n'ai pas touché le code...

Le

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.Rows

vient de

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

LigneFeuilleCible = .Cells(.Rows.Count, 2).End(xlUp).Row + 1

C bizarre qu'il fonctionne chez toi

Les seule choses que j'ai changé, ce sont les mots recherchés et l'intitulé de la procédure.

Seb

[Invité]

Les seule choses que j'ai changé, ce sont les mots recherchés et l'intitulé de la procédure.

Le message que tu as, n'est pas forcément en rapport avec cette ligne.

A tout hasard, peux-tu remplacer dans ton code, le point devant Rows.Count (lorsque j'ai collé le code dans le message, je me suis aperçu que j'avais oublié ce point, j'ai donc modifié le code directement sans vérifier la compilation sur mon micro).

Sinon, remplace la ligne par :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

LigneFeuilleCible = ShCible.Cells(Shcible.Rows.Count, 2).End(xlUp).Row + 1

Autrement :

-Lorsque je t'ai envoyé le code la première fois, confirmes-tu qu'il fonctionnait correctement ?
-Dans ce cas, peux-tu remplacer le nom de la procédure par Cherche ?


Sinon :

-Bien que le message d'erreur ne serait pas le même, le nom de la procédure et des variables sont-ils uniques dans ton fichier ?
-Si des variables de la procédure se retrouvent dans d'autres parties du projet VBA, comment sont-elles déclarées ?
-Peux-tu remplacer le nom de ta variable c par Cellule par exemple ?

Enfin :

-Peux-tu mettre tout le code de la procédure en ligne ?


Cordialement.

[Sebphyto]

Salut Eric;

Niquel ça fonctionne en rajoutant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

LigneFeuilleCible = ShCible.Cells(Shcible.Rows.Count, 2).End(xlUp).Row + 1

Merci beaucoup pour ce que tu as fait

A bientôt sur d'autre post

Ps:
- http://www.developpez.net/forums/d15...e-requete-web/
- http://www.developpez.net/forums/d15...em-collection/
- http://www.developpez.net/forums/d14...lules-textbox/