Utilisation de Find et FindNext
Bonjour,
Je vient chercher de l'aide car je souhaite faire un find next et une boucle mais cela ne fonctionne pas : pouvez vous me dire ce qui va pas dans mon code s'il vous plait ?
Code:
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
32
33
34
35
36
37
38
39
40
41
42
43
|
Private Sub CommandButton3_Click()
Dim wb As Workbook
Dim ws As Worksheet
Dim r As Range 'déclare la variable r (Recherche)
Dim tr As String 'déclare la variable tr (Texte Recherché)
Dim li As Integer 'déclare la variable li (Ligne)
Dim listebox, premiereoccurence As Integer
Dim applitrouvee As Range
Dim tableau(50) As Integer
Set wb = Workbooks.Open("U:\ICDC\DPI\OPE\Oac\2.Applicatif\Référentiel applis.xls")
Set ws = wb.Worksheets(1)
Sheets("Réf applis").Select
Range("A1").Select
tr = TextBox1.Value 'définit la variable tr
Set applitrouvee = Cells.Find(What:=tr, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
premiereoccurence = applitrouvee.Row
If applitrouvee Is Nothing Then
MsgBox "Aucune application trouvée!", , "Résultat"
Else
Do
applitrouvee = Cells.FindNext(applitrouvee)
Loop While applitrouvee.Row <> premiereoccurence
li = ActiveCell.Row
Range("A" & li).Select
For listebox = 1 To 4
UserForm2.ListBox1.AddItem Range("A" & li)
Next listebox |
Utilisation de Find et FindNext
Bonjour à tous,
Mes tous premiers pas en VBA!! Et j'avoue que c'est presque physiquement douloureux!
Donc voici mon problème: Dans mon classeur il y a 4 feuilles "Results KFT" "Blanks" "Controls" & "Samples"
Dans la première feuille("Results KFT") se trouvent tous les résultats de mes analyses que ce soient des blancs, des contrôles ou des échantillons.
Je veux faire une macro qui me permette de trier mes résultats et de les ranger dans les feuilles suivantes! Pour cela je veux chercher dans la 2eme colonne de ma 1ère page les mots clés suivant "Blanc", "Contrôle" et "échantillon" puis que la ligne où ils apparaissent soient copiée dans la feuille "Blanks" si c'est le mot clé Blanc; "Controls" si c'est Contrôle et évidemment "Samples" si c'est échantillon.
J'ai donc piqué (!) un code Find sur le forum pour y arriver, bon déjà le résultat n'était pas parfait mais surtout ça s'arrête sur le premier "Blanc". Donc j'ai trouvé FindNext (on avance!!) mais c'est plus compliqué, surtout qu'en plus maintenant j'ai un message 'Erreur d'exécution '438': Propriété ou méthode non gérée par cet objet" Ca devient vraiment difficile!!!
Voici mon code, bourré de manque et de bout de truc ajouté pour essayer! Je sais :-(
Est ce que quelqu'un peut m'aider ?
PS: la honte, je ne sais même pas comment faire apparaitre mon code correctement... Soyez indulgent svp!
Code:
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 tri_blank_control_sample()
Dim MotCle
Dim NomFeuille
Dim i As Byte
Dim C As Range
Dim B As String
Dim Ligne As Integer
'On définit les mots clés
MotCle = Array("Blanc", "Contrôle", "échantillon")
NomFeuille = Array("Blanks", "Controls", "Samples")
'On effectue la recherche de chaque mot clé dans la colonne B de la sheet1
For i = 0 To UBound(MotCle)
Do
Set C = Worksheets("KFT results").Columns(2).Find(MotCle(i), LookIn:=xlValues, lookat:=xlPart)
'Si le mot clé est trouvé
If Not C Is Nothing Then
firstAddress = C.Address
'On définit le nom de la feuille où sera effectuée la copie
B = NomFeuille(i)
With Worksheets(B)
'On définit la ligne où sera effectué le collage
Ligne = .Range("B" & Rows.Count).End(xlUp).Row + 1
'On effectue le copier / coller
C.EntireRow.Copy .Range("A" & Ligne)
Set C = .FindNext(C)
End With
End If
Loop While Not C Is Nothing And C.Address <> firstAddress
Next i
End Sub |
Qqs commentaires sur ton code.
Je vais compléter ma réponse, en t'expliquant ce qui ne va pas (d'autre ;) ) dans ton code et, entre autre, pourquoi tu as le message d'erreur que tu cites. C'est pour t'aider à progresser et comprendre. Mais je pense que la solution que je te propose dans le message précédent est plus efficace que ce que tu veux faire.
D'abord, :idea: conseil : indente ton code, c'est plus facile de s'y retrouver dans les boucles, conditions if, while etc. Voici ton code tel quel :
Code:
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 tri_blank_control_sample()
Dim MotCle
Dim NomFeuille
Dim i As Byte
Dim C As Range
Dim B As String
Dim Ligne As Integer
'On définit les mots clés
MotCle = Array("Blanc", "Contrôle", "échantillon")
NomFeuille = Array("Blanks", "Controls", "Samples")
'On effectue la recherche de chaque mot clé dans la colonne B de la sheet1
For i = 0 To UBound(MotCle)
Do
Set C = Worksheets("KFT results").Columns(2).Find(MotCle(i), LookIn:=xlValues, lookat:=xlPart)
'Si le mot clé est trouvé
If Not C Is Nothing Then
firstAddress = C.Address
'On définit le nom de la feuille où sera effectuée la copie
B = NomFeuille(i)
With Worksheets(B)
'On définit la ligne où sera effectué le collage
Ligne = .Range("B" & Rows.Count).End(xlUp).Row + 1
'On effectue le copier / coller
C.EntireRow.Copy .Range("A" & Ligne)
Set C = .FindNext(C)
End With
End If
Loop While Not C Is Nothing And C.Address <> firstAddress
Next i
End Sub |
1. Utilisation de With et FindNext
Faisons un zoom sur le bloc With...End With :
Code:
1
2
3
4
5
6
7
| With Worksheets(B)
'On définit la ligne où sera effectué le collage
Ligne = .Range("B" & Rows.Count).End(xlUp).Row + 1
'On effectue le copier / coller
C.EntireRow.Copy .Range("A" & Ligne)
Set C = .FindNext(C)
End With |
D'après la syntaxe du bloc With...End With, ce qui est écrit en orange ci-dessus est équivalent à :
Code:
Set C = Worksheets(B).FindNext(C)
Or comme pour Find que tu as bien écrit, FindNext s'applique sur un Range et pas sur une feuille.
Et en plus, tu es censée faire ta recherche sur la feuille "KFT résultat" et pas sur la feuille B (c'est ce que tu fais dans ton Find). Donc tu ne cherches pas au bon endroit.
Donc première correction :
Code:
1
2
3
4
5
6
7
| With Worksheets(B)
'On définit la ligne où sera effectué le collage
Ligne = .Range("B" & Rows.Count).End(xlUp).Row + 1
'On effectue le copier / coller
C.EntireRow.Copy .Range("A" & Ligne)
End With
Set C = Worksheets("KFT results").Columns(2).FindNext(C) |
Il n'y aura plus d'erreur, mais tu n'auras quand même pas ce que tu veux ...
2. Find dans la boucle
Pour bien comprendre ce que fait le code à ce stade, exécutons le "virtuellement" pas à pas. On va se concentrer sur la boucle Do... While :
Code:
1
2
3
4
5
6
7
8
| Do
Set C = Worksheets("KFT results").Columns(2).Find(MotCle(i), LookIn:=xlValues, lookat:=xlPart)
'Si le mot clé est trouvé
If Not C Is Nothing Then
'blablablablablablablablalbblbla
Set C = Worksheets("KFT results").Columns(2).FindNext(C)
End If
Loop While Not C Is Nothing And C.Address <> firstAddress |
- 1ère itération : on cherche le mot clé dans la colonne B et on attribut la cellule trouvée à C.
On suppose que C n'est pas Nothing => on fait un certain nombre d'opétation (blablabl;ablalb...)
Puis, on attribue à C le résultat de FindNext, donc la prochaine cellule contenant le mot clé.
On arrive à Loop => les 2 conditions sont respectées, donc on effectue à nouveau la boucle à partir de Do. - 2ème itération : on cherche le mot clé dans la colonne B et on attribut la cellule trouvée à C.
Et là, c'est le drame ! :calim2:
En effet, on vient juste d'effectuer à nouveau la première recherche. Ou plutôt on attribue à C la recherche sur toute la colonne B. Or toi, ce que tu voulais faire, en utilisant FindNext, c'était de trouver la prochaine occurrence après celle qu'on vient de chercher. Donc en fait, à chaque fois ton C va être la première occurrence du mot clef.
Ce qu'il faudrait faire :
- Hors de la boucle, faire la première recherche.
- Commencer la boucle en faisant les opérations (blablablabla) et en finissant avec le FindNext.
Cela donnerait qqc comme cela :
Code:
1
2
3
4
5
6
7
8
| Set C = Worksheets("KFT results").Columns(2).Find(MotCle(i), LookIn:=xlValues, lookat:=xlPart)
Do
'Si le mot clé est trouvé
If Not C Is Nothing Then
'blablablablablablablablalbblbla
Set C = Worksheets("KFT results").Columns(2).FindNext(C)
End If
Loop While Not C Is Nothing And C.Address <> firstAddress |
Maintenant, je te conseille de refaire l'exercice où tu exécutes "virtuellement" pas à pas le code pour comprendre en quoi cela est plus fonctionnel.
Oh non ! J'ai dit "plus fonctionnel". ça veut dire que c'est pas encore bon ? :calim2:
Et non ...
3. Définition de firstAddress
Ici l'erreur est directement reliée à l'erreur précédente. Et peut-être l'as-tu détectée en faisant l'exercice d’exécution "virtuelle" pas à pas.
L'erreur se cache dans le "blablablablabl...", alors réécrivons la boucle en explicitant ce blabla.
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
| Set C = Worksheets("KFT results").Columns(2).Find(MotCle(i), LookIn:=xlValues, lookat:=xlPart)
Do
'Si le mot clé est trouvé
If Not C Is Nothing Then
firstAddress = C.Address
'On définit le nom de la feuille où sera effectuée la copie
B = NomFeuille(i)
With Worksheets(B)
'On définit la ligne où sera effectué le collage
Ligne = .Range("B" & Rows.Count).End(xlUp).Row + 1
'On effectue le copier / coller
C.EntireRow.Copy .Range("A" & Ligne)
End With
Set C = Worksheets("KFT results").Columns(2).FindNext(C)
End If
Loop While Not C Is Nothing And C.Address <> firstAddress |
A chaque itération de la boucle, tu attribus à firstAddress l'adresse de la nouvelle cellule C. Or comme le dit le nom de la variable, ici on veut garder la première adresse trouvée pour détecter le moment où il faut arrêter la boucle. Donc comme pour le premier Find, il faut sortir cela de la boucle pour que ce ne soit pas remis à jour à chaque itération.
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
| Set C = Worksheets("KFT results").Columns(2).Find(MotCle(i), LookIn:=xlValues, lookat:=xlPart)
If Not C Is Nothing then firstAddress = C.Address
Do
'Si le mot clé est trouvé
If Not C Is Nothing Then
'On définit le nom de la feuille où sera effectuée la copie
B = NomFeuille(i)
With Worksheets(B)
'On définit la ligne où sera effectué le collage
Ligne = .Range("B" & Rows.Count).End(xlUp).Row + 1
'On effectue le copier / coller
C.EntireRow.Copy .Range("A" & Ligne)
End With
Set C = Worksheets("KFT results").Columns(2).FindNext(C)
End If
Loop While Not C Is Nothing And C.Address <> firstAddress |
Et là on devrait être pas trop mal :)
Tout ceci n'est que pour t'aider à progresser et comprendre qu'elles sont les erreurs dans ton code. Je reste sur ma première position : ce n'est pas le meilleur moyen de faire ce que tu veux faire. Il vaut mieux passer par les filtres. Beaucoup plus rapide.
