Discussion :

[macro le noir]

Bonjour, je travaille sur un fichier regroupant toutes des informations sur certaines normes du style nom, numéro, année... pour pouvoir les retrouver plus facilement dans nos dossiers. Je voudrais faire une recherche de normes par mot clé ou par numéro via un formulaire.
Je joins un exemple qui fonctionne comme ceci :
Le formulaire s'ouvre à l'ouverture du fichier, cliquez sur chercher une norme puis sur mot clé ou numéro puis valider. Cherchez un mot au hasard (exemple : métrologie) et validez. Il me trouve bien des résultats mais 6 fois le même à chaque fois.
Je voudrais que la recherche me sorte tout ce qui correspond au mot clé dans la feuille résultats et ceci sans doublons. Auriez-vous une solution à m'apporter svp ?

Ps : Le code se trouve dans le formulaire UserMot, les autres formulaires ne sont pas finis alors ne vous étonnez pas si rien ne marche. J'ai bien entendu chercher des solutions sur la toile mais je n'ai rien pu mettre en oeuvre qui marche correctement.

[patricktoulon]

Bonjour
en fait il y a plusieurs problème dans ton raisonnement

tu fait ta recherche comme ceci dans ta boucle de 6 tour

Code :

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

1
2
For n = 1 To 6
    Set c = Sheets("Normes").Range("A2:F500").Find("*" & TextBox1.Value & "*", LookIn:=xlValues, LookAt:=xlPart)

il faut savoir qu'a chaque boucle la recherche redémarre a la première cellule de la plage qui reste la même a chaque boucle puisque elle est écrite en dur

moi j'aurais fait pluto ceci:

Code :

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

Set c = Sheets("Normes").Range(colonnes(n) & ":" & colonnes(n)).Find("*" & TextBox1.Value & "*", LookIn:=xlValues, LookAt:=xlPart)

a chaque tour de boucle on change de colonne

mais cependant on a un autre probleme

find trouve la première occurrence du mot recherché

et si il y en a plusieurs dans la même colonne les autres on s'en fou???????

tu devrais regarder dans l'aide sur find et find next tu en a un exemple très simple

si tu n'y arrive pas reviens avec un essai probant je te le corrigerais

[macro le noir]

J'ai regardé l'aide excel et j'ai mis ce 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
Private Sub CommandButton1_Click()
 
Sheets("Résultats").Range("A4:F65536").ClearContents
Sheets("Résultats").Range("B1") = TextBox1.Value
 
If TextBox1.Value = "" Then
  MsgBox ("Entrez au moins un mot/numéro à rechercher.")
  Exit Sub
End If
 
With Worksheets("Normes").Range("A2:F500")
    Set c = .Find(TextBox1.Value, LookIn:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
' Dans l'aide il y avait ici :c.Value = 5, je l'ai enlevé
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With
 
Unload Me
 
End Sub

En lançant ce code (tiré de l'aide excel) qui remplace entièrement le code pompeux avec la boucle que j'avais avant, j'obtiens...rien. Je me doute que c'est parce qu'il n'y a pas d'ordre de copier/coller ou quelque chose du genre, mais je ne vois pas comment faire pour qu'il me colle uniquement mes lignes contenant le mot clé (et sans doublons ce sera cool)

[patricktoulon]

tiens
remplace la macro du bouton

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
32
33
34
35
36
37
38
 
Private Sub CommandButton1_Click()
 
Sheets("Résultats").Range("A4:F65536").ClearContents
Sheets("Résultats").Range("B1") = TextBox1.Value
colonnes = Array("A", "B", "C", "D", "E", "F")
 
If TextBox1.Value = "" Then
  MsgBox ("Entrez au moins un mot/numéro à rechercher.")
  Exit Sub
End If
 
With Worksheets("Normes").Range("a2:f500")
    Set c = .Find("*" & TextBox1.Value & "*", LookIn:=xlValues, LookAt:=xlPart)
    If Not c Is Nothing Then
        firstadresse = c.Address
        Do
            ligne = Sheets("Résultats").Range("A65536").End(xlUp).Row + 1
 
      Sheets("Résultats").Cells(ligne, 1) = Sheets("Normes").Range(colonnes(0) & c.Row)
      Sheets("Résultats").Cells(ligne, 2) = Sheets("Normes").Range(colonnes(1) & c.Row)
      Sheets("Résultats").Cells(ligne, 3) = Sheets("Normes").Range(colonnes(2) & c.Row)
      Sheets("Résultats").Cells(ligne, 4) = Sheets("Normes").Range(colonnes(3) & c.Row)
      Sheets("Résultats").Cells(ligne, 5) = Sheets("Normes").Range(colonnes(4) & c.Row)
      Sheets("Résultats").Cells(ligne, 6) = Sheets("Normes").Range(colonnes(5) & c.Row)
      Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstadresse
    End If
End With
 
Sheets("Résultats").Select
With ActiveSheet.Columns("A:F")
        .WrapText = True
        .ShrinkToFit = True
End With
Unload Me
 
End Sub

au plaisir

[macro le noir]

Merci c'est exactement ce que je veux à un petit détail près, il y a des doublons lorsque tu cherche un mot qui apparaît deux fois dans la même ligne. Connais-tu le moyen de les enlever ? (exemple avec le mot vérif)

Mais sinon merci beaucoup

[patricktoulon]

tiens voila une versdion avec la verification de ligne

si la ligne a été déjà visité on saute au prochain

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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
 
Private Sub CommandButton1_Click()
 
Sheets("Résultats").Range("A4:F65536").ClearContents
Sheets("Résultats").Range("B1") = TextBox1.Value
colonnes = Array("A", "B", "C", "D", "E", "F")
 
If TextBox1.Value = "" Then
  MsgBox ("Entrez au moins un mot/numéro à rechercher.")
  Exit Sub
End If
 
With Worksheets("Normes").Range("a2:f500")
    Set c = .Find("*" & TextBox1.Value & "*", LookIn:=xlValues, LookAt:=xlPart)
    If Not c Is Nothing Then
      firstadresse = c.Address
        Do
 
          If InStr(listeligne, c.Row) < 1 Then
 
            ligne = Sheets("Résultats").Range("A65536").End(xlUp).Row + 1
 
      Sheets("Résultats").Cells(ligne, 1) = Sheets("Normes").Range(colonnes(0) & c.Row)
      Sheets("Résultats").Cells(ligne, 2) = Sheets("Normes").Range(colonnes(1) & c.Row)
      Sheets("Résultats").Cells(ligne, 3) = Sheets("Normes").Range(colonnes(2) & c.Row)
      Sheets("Résultats").Cells(ligne, 4) = Sheets("Normes").Range(colonnes(3) & c.Row)
      Sheets("Résultats").Cells(ligne, 5) = Sheets("Normes").Range(colonnes(4) & c.Row)
      Sheets("Résultats").Cells(ligne, 6) = Sheets("Normes").Range(colonnes(5) & c.Row)
      End If
      listeligne = listeligne & vbCrLf & c.Row
      Set c = .FindNext(c)
 
 
        Loop While Not c Is Nothing And c.Address <> firstadresse
    End If
End With
 
Sheets("Résultats").Select
With ActiveSheet.Columns("A:F")
        .WrapText = True
        .ShrinkToFit = True
End With
Unload Me
 
End Sub

Au plaisir