Discussion :

[Giantrick]

Bonjour,

J'ai lu plusieurs sujet sur la commande (find) et je dois dire que je ne suis pas encore très bon en macro... mais là je butte.

J'ai la logique, mais je bloque sur la formulation.

Voici ce que je souhaite faire :

- j'ai deux fichiers excel
(Fichier A) doit permettre d'afficher des données en fonction de trois critères.
(Fichier B) contient les données brutes à récupérer.

La macro est située sur le fichier A et doit :
- trouver les lignes (il peut y en avoir une ou plusieurs, ou aucune)
qui correspondent aux trois critères sélectionnés via des menus déroulants choisi par l'utilisateur du fichier A
Pour information :
- Le critère C doit être trouvé dans la colonne K
- Le critère D doit être trouvé dans la colonne L
- Le critère E doit être trouvé dans la colonne M
- L'id a récupérer est en colonne A

- Ensuite il faut recopier la première ligne puis les autres du fichier B dans le fichier A

Voici ce que je voulais faire mais cela ne fonctionne pas :

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
Dim LastLig As Long
sub find()
Dim C As Range, D As Range, E As Range, Result As Range, Nblign As Range
Set C = Range("H7") 'premier critère
Set D = Range("H8") 'second criètre
Set E = Range("H9") 'troisième critère
'zone où l'information doit être recherchée
    ' zone ou l'information doit être prise (source de l'information)
    For Each Result Workbooks("fichierB.xlsx").Worksheets("Ongletsource")
            ' zone où l'on trouve la première ligne
            Set Nbligne = .Range("K:K").find(C.Value, LookIn:=xlValues, LookAt:=xlPart) AND .Range("L:L").find(D.Value, LookIn:=xlValues, LookAt:=xlPart) AND .Range("M:M").find(D.Value, LookIn:=xlValues, LookAt:=xlPart)
            If Not Nbligne Is Nothing Then
            Set Result = Nbligne.Offset(0, -10) 'le -10 nous ramène à la colonne A
            MsgBox "le résultat est " & Result ' pour vérifier la valeur retournée
'ensuite je ne sais pas comment recopier la ligne trouvée dans le fichier A
'et s'assurer que la boucle va retourner chaque ligne trouvée pour ses trois critères simultanés.
                Set Nbligne = Nothing
        End If
    Next Result

Merci d'avance de vos retours...

[mercatog]

L'idée est de filtrer (Filtre automatique) la feuille du classeur B en fonction des 3 critères issus du classeur A et de recopier le résultat

[Giantrick]

De façon manuelle, je suis d'accord, mais je souhaite le faire avec une macro.

Merci du retour.

[mercatog]

Si tu peux le faire manuellement, c'est que par macro est aussi simple.

Exemple non testé à adapter

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
Sub Test()
Dim Ws As Worksheet
Dim LastLig As Long
Dim C As String, D As String, E As String
 
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets("Feuil1")
    C = .Range("H7")                             'premier critère
    D = .Range("H8")                             'second criètre
    E = .Range("H9")                             'troisième critère
    Set Ws = Workbooks("fichierB.xlsx").Worksheets("Ongletsource")    'Le fichier FichierB doit être ouvert (et dans la même instance)
    With Ws
        .AutoFilterMode = False
        LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
        If C <> "" Then .Range("A1:X" & LastLig).AutoFilter Field:=11, Criteria1:=C
        If D <> "" Then .Range("A1:X" & LastLig).AutoFilter Field:=12, Criteria1:=D
        If E <> "" Then .Range("A1:X" & LastLig).AutoFilter Field:=13, Criteria1:=E
        If .Range("A1:A" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then
            .Range("A2:A" & LastLig).SpecialCells(xlCellTypeVisible).Copy ThisWorkbook.Worksheets("Feuil1").Range("A2")
        End If
        .AutoFilterMode = False
    End With
    Set Ws = Nothing
End With
End Sub

[Giantrick]

c'est parfait, cela fonctionne très très bien.

Merci beaucoup.

Bonne journée

[Giantrick]

Re-bonjour,

je reviens vers toi car j'aimerais faire un test sur une valeur de chaque ligne.

J'ai tenté ce bout de code à la suite de celui que tu m'as transmis, mais je dois mal écrire la macro.

J'ai la logique, mais je pèche sur la manière d'écrire le code. Il y a une erreur en ligne 26, et peut être après.

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
 
Dim Ws As Worksheet
Dim LastLig As Long, Numligne As Long
Dim C As String, D As String, E As String, MD As String, MC As String, v As Range
 
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets("Feuil1")
    C = .Range("H7")                             'premier critère
    D = .Range("H8")                             'second criètre
    E = .Range("H9")                             'troisième critère
    Set Ws = Workbooks("fichierB.xlsx").Worksheets("Ongletsource")    'Le fichier FichierB doit être ouvert (et dans la même instance)
    With Ws
        .AutoFilterMode = False
        LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
        If C <> "" Then .Range("A1:X" & LastLig).AutoFilter Field:=11, Criteria1:=C
        If D <> "" Then .Range("A1:X" & LastLig).AutoFilter Field:=12, Criteria1:=D
        If E <> "" Then .Range("A1:X" & LastLig).AutoFilter Field:=13, Criteria1:=E
        If .Range("A1:A" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then
            .Range("A2:A" & LastLig).SpecialCells(xlCellTypeVisible).Copy ThisWorkbook.Worksheets("Feuil1").Range("A2")
        End If
' debut de mon code pour appliquer une condition en fonction du résultat de la cellule Ix de chaque ligne trouvé par le trie ci-dessus
Numligne = 1 'on débute à la seconde ligne
        For Each v In Range("a2:a" & LastLig) 'on boucle sur la selection trouvée
        If Numligne <= LastLig Then 'si la numéro de la ligne est inférieur ou égale au nombre de ligne total (lastlig) on continue
            Numligne = Numligne + 1 'on incrémente de 1
               If .Cells("I" & Numligne & ":I" & Numligne) < 0 Then 'on test si la cellule est inférieure à zéro, si c'est le cas on exécute ci-dessous sinon on va au else
                    MD = -.Cells("I" & Numligne & ":I" & Numligne).SpecialCells(xlCellTypeVisible).Value
                    Cells(MD).Copy ThisWorkbook.Worksheets("Feuil1").Range("H13") ' Gauche
                Else
                  MC = .Cells("I" & Numligne & ":I" & Numligne).SpecialCells(xlCellTypeVisible).Value
                    Cells(MC).Copy ThisWorkbook.Worksheets("Feuill1").Range("I13") ' Droite
 
           End If          
 
        End If
    Next v
' la suite de ton code
    .AutoFilterMode = False
    End With
    Set Ws = Nothing
End With
End Sub

Merci de ton retour.