Discussion :

[Djules]

Bonjour à tous,

En stage, on me demande de trouver une solutions pour rechercher des informations dans une liste de données (feuille DONNEES), qui fera par la suite plus de 3000 lignes. Je suppose donc qu'il faut utiliser un petit programme en VBA, mais malheureusement je n'ai aucune connaissance dans ce langage.
J'ai tout de même essayé, mais mon programme ne fonctionne pas et j'ai un message d'erreur 438 qui s'affiche.
C'est pourquoi je fais appel à vous et à votre savoir. Je pense que pour quelqu'un qui s'y connait un peu ce sera vraiment facile (je l'espère).

L'objectif de ce programme est d'avoir une feuille (RECHERCHE) qui sert d'interface et où l'utilisateur peut choisir un lieux, un secteur, un fournisseur ou spécifier un équipement. Chacun de ces champs ne doit pas forcément être spécifié.
En appuyant sur le bouton "lancer la recherche" toutes les lignes de données qui recoupent toutes les informations spécifiées doivent s'afficher dans le tableau de la feuille recherche.

Je vous envoie un extrait de ce qui a été fait. J'espère sincèrement que vous pourrez m'aider. Si vous avez des commentaires sur ce que j'ai codé, je veux bien les entendre, ainsi je progresserai un peu.

Merci à vous et bonne soirée.
Julie =)

[Daniel.C]

Bonsoir,

Essaie cette macro. Plutôt qu'une boucle, j'ai utilisé un filtre automatique. Si ça te convient, je te donnerai toutes les explications nécessaires.

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
Sub recherche()
Dim Plage As Range
Set sh = Sheets("RECHERCHE")
sh.[B19:J10000].ClearContents
With Sheets("DONNEES")
    Set Plage = .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 9)
    .AutoFilterMode = False
    If sh.[G10] <> "" Then Plage.AutoFilter 1, sh.[G10]
    If sh.[D8] <> "" Then Plage.AutoFilter 6, sh.[D8]
    If sh.[G8] <> "" Then Plage.AutoFilter 3, sh.[G8]
    If sh.[D10] <> "" Then Plage.AutoFilter 7, sh.[D10]
    If sh.[G10] = "" And sh.[G8] = "" And sh.[D8] = "" And sh.[D10] = "" Then
        MsgBox "Aucune sélection"
        Exit Sub
    End If
    Set Plage = Plage.Offset(1).Resize(Plage.Rows.Count - 1)
    If Application.Subtotal(103, Plage) > 0 Then
        Set Plage = Plage.SpecialCells(xlCellTypeVisible)
        Plage.Copy
        sh.[B19].PasteSpecial xlPasteValues
    End If
    .AutoFilterMode = False
End With
End Sub

PS. Mets plutôt la macro dans un module standard.

[Sogestion]

Bonjour Daniel,

Merci pour cette leçon

__________________
Cordialement

[Daniel.C]

Bonjour,

Chose promise, chose due, même si tu n'as pas l'air d'en avoir besoin, j'ai commenté le 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
32
33
34
Sub recherche()
Dim Plage As Range
Set sh = Sheets("RECHERCHE")
'effacement de la plage des résultats
sh.[B19:J10000].ClearContents
With Sheets("DONNEES")
    'on affecte à la variable "Plage" la plage des données à chercher
    Set Plage = .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 9)
    'on efface le filtre automatique s'il existe
    .AutoFilterMode = False
    'positionnement des filtres si la cellule est renseignée
    If sh.[G10] <> "" Then Plage.AutoFilter 1, sh.[G10]
    If sh.[D8] <> "" Then Plage.AutoFilter 6, sh.[D8]
    If sh.[G8] <> "" Then Plage.AutoFilter 3, sh.[G8]
    If sh.[D10] <> "" Then Plage.AutoFilter 7, sh.[D10]
    'si aucune cellule n'est renseignée, message d'erreur et fin de la macro
    If sh.[G10] = "" And sh.[G8] = "" And sh.[D8] = "" And sh.[D10] = "" Then
        MsgBox "Aucune sélection"
        Exit Sub
    End If
    'Redimensionnement de la plage filtrée pour éliminer les entêtes
    Set Plage = Plage.Offset(1).Resize(Plage.Rows.Count - 1)
    'utilisation de la fonction "SOUS.TOTAL" pour déterminer si il y a des lignes filtrées
    If Application.Subtotal(103, Plage) > 0 Then
        'si oui, on ne conserve que les lignes filtrées
        Set Plage = Plage.SpecialCells(xlCellTypeVisible)
        'et on les copie - colle sur la plage des résultats
        Plage.Copy
        sh.[B19].PasteSpecial xlPasteValues
    End If
    'on efface le filtre automatique
    .AutoFilterMode = False
End With
End Sub

[CodeFacile]

La solution proposée est très difficile à apréhender pour un débutant .
Juste pour éclairer un peu Djules sur ses erreurs dans le module recherche,

le problème erreur 438 provient du fait qu'il y a des références

Code :

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

1
2
3
4
 
cell (x , y) 
 'alors qu'il faut corriger par 
 cells ( x,y)

la méthode était cohérente mais la recherche ne pouvait ramener qqchose que lorsque les 4 critéres étaient renseignés.
- Il faut adopter une structure qui permettent de ne pas comparer la colonne lorsque le critére n'est pas renseigné ( voir solution ).
- dernière erreur , il ne faut pas incrémenter le paramètre i qui sert dans la boucle for ( i est géré par la structure for , ne pas toucher ! )


Voici ta fonction recherche corrigé :

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
46
47
48
49
50
51
52
53
54
 
Sub recherche()
 
Dim lieux, fournisseur, secteur, equipement As String
Dim pass_test_lieux, pass_test_fournisseur, pass_test_secteur, pass_test_equipement As Boolean
Dim nb_result As Integer: nb_result = 0
 
'on efface les resultats de la recherche précédente :
Worksheets("RECHERCHE").Range("A19:J3000").ClearContents
 
If Worksheets("RECHERCHE").Range("D8").Value <> "" Then
  lieux = Worksheets("RECHERCHE").Range("D8"):    pass_test_lieux = False
Else
  pass_test_lieux = True
End If
 
If Worksheets("RECHERCHE").Range("G8").Value <> "" Then
    fournisseur = Worksheets("RECHERCHE").Range("G8").Value: pass_test_fournisseur = False
Else
   pass_test_fournisseur = True
End If
 
If Worksheets("RECHERCHE").Range("D10").Value <> "" Then
secteur = Worksheets("RECHERCHE").Range("D10").Value: pass_test_secteur = False
Else
pass_test_secteur = True
End If
 
If Worksheets("RECHERCHE").Range("G10").Value <> "" Then
equipement = Worksheets("RECHERCHE").Range("G10").Value: pass_test_equipement = False
Else
pass_test_equipement = True
End If
 
 
For i = 1 To 3000
 
If (Worksheets("DONNEES").Cells(i, 6).Value = lieux Or pass_test_lieux) And _
  (Worksheets("DONNEES").Cells(i, 3).Value = fournisseur Or pass_test_fournisseur) And _
   (Worksheets("DONNEES").Cells(i, 7).Value = secteur Or pass_test_secteur) And _
   (Worksheets("DONNEES").Cells(i, 1).Value = equipement Or pass_test_equipement) Then
     nb_result = nb_result + 1
 
        For c = 1 To 10
            Worksheets("RECHERCHE").Cells(18 + nb_result, c + 1).Value = Worksheets("DONNEES").Cells(i, c).Value
        Next
End If
Next
 
Worksheets("RECHERCHE").Range("F13 ") = nb_result
 
Worksheets("RECHERCHE").Select
 
End Sub