recherche de données

**chloe74** · 27/07/2020, 21h03

bonsoir,
est-ce qu'il est possible de faire une macro qui pourrais faire ceci ( cela semble compliqué ) :

il y a des donnée chiffré de la colonne A à D et de la colonne F à I
les lignes de la colonne F à I sont grouper en 5 lignes

si les 5 lignes ( premier bloc ) apparaissent dans les lignes des colonnes A à D alors écrire " oui " a coté de la première ligne a droite,

si il n'y a que 0,1,2,3 ou 4 lignes qui apparaisse alors écrire " non "
voici un exemple du résultat : devlopez_forum.xlsm

merci

**ARTURO83** · 28/07/2020, 07h55

Bonjour,

Votre tableau 2 ne colle pas à ce que vous demandez, en voici un autre avec des données se rapportant à votre demande (5 lignes parfaitement identiques).
Pièce jointe 575985

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
35
36
37
38
39
40
41
42
43
44
Sub Marquage()
    Dim DerLig_T1 As Long, DerLig_T2 As Long, i As Long
    Dim o As Object, n As Object
    Application.ScreenUpdating = False
    Columns(11).ClearContents
    'Contrôle de la présence de 5 lignes identiques du tableau 2
    DerLig_T1 = Columns("A").Find(What:="*", SearchDirection:=xlPrevious).Row
    DerLig_T2 = Columns("F").Find(What:="*", SearchDirection:=xlPrevious).Row
    Set T2 = Range("F2:I" & DerLig_T2)
    Range("J2:J" & DerLig_T2).FormulaR1C1 = "=RC[-4]&"" ""&RC[-3]&"" ""&RC[-2]&"" ""&RC[-1]"
    Range("J2:J" & DerLig_T2).Value = Range("J2:J" & DerLig_T2).Value
 
    For i = 2 To DerLig_T2
        If Cells(i, "J") = Cells(i + 1, "J") And Cells(i, "J") = Cells(i + 2, "J") And _
        Cells(i, "J") = Cells(i + 3, "J") And Cells(i, "J") = Cells(i + 4, "J") Then
            Range(Cells(i + 1, "J"), Cells(i + 4, "J")).ClearContents
            i = i + 4
        Else
            Cells(i, "K") = "non"
            Cells(i, "J") = ""
        End If
    Next i
 
    'Recherche dans le tableau 1
    With Columns(10)
        Set o = .Find(" ")
        If Not o Is Nothing Then
            o_Adr = o.Address
            Do
                Cells(o.Row, "K").FormulaArray = "=IFERROR(IF(RC[-1]<>"""",MATCH(RC10,R1C1:R" & DerLig_T1 & "C1&"" ""&R1C2:R" & DerLig_T1 & "C2&"" ""&R1C3:R" & DerLig_T1 & "C3&"" ""&R1C4:R" & DerLig_T1 & "C4,0),""""),"""")"
                Cells(o.Row, "K").Value = "oui"
                Set o = .FindNext(o)
            Loop While Not o Is Nothing And o_Adr <> o.Address
        End If
    End With
 
    'Suppression des "non" consécutifs
    For i = DerLig_T2 To 2 Step -1
        If Cells(i, "K") = "non" And Cells(i - 1, "K") = "non" Then Cells(i, "K") = ""
    Next i
 
    Columns(10).ClearContents
    Set o = Nothing
End Sub

Cdlt

**chloe74** · 28/07/2020, 09h13

Envoyé par ARTURO83

Bonjour,

Votre tableau 2 ne colle pas à ce que vous demandez, en voici un autre avec des données se rapportant à votre demande (5 lignes parfaitement identiques).

bonjour,
je pense que j'ai dû mal expliquer

les valeurs de mon tableau 2 sont justes ils ne fallait pas les changer,
par exemple j'ai en tableau 2 :

1-2-3-4
1-2-3-5
1-3-4-5
1-2-4-5
2-3-4-5

si toutes ses valeurs apparaissent dans le tableau 1 alors écrire oui à coté si il n'y a que 4 ou moins de lignes correspondante alors écrire non puis passer au prochain bloc donc de la ligne 6 à 10
merci

**ARTURO83** · 28/07/2020, 12h10

Ok, j'avais mal compris, essayez ceci

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
55
56
57
58
Sub Marquage()
    Dim DerLig_T1 As Long, DerLig_T2 As Long, i As Long, Cpt As Long
    Dim o As Object, n As Object
    Application.ScreenUpdating = False
    Columns(11).ClearContents
    'Contrôle de la présence de 5 lignes identiques du tableau 2
    DerLig_T1 = Columns("A").Find(What:="*", SearchDirection:=xlPrevious).Row
    DerLig_T2 = Columns("F").Find(What:="*", SearchDirection:=xlPrevious).Row
    Set T2 = Range("F2:I" & DerLig_T2)
    Range("J2:J" & DerLig_T2).FormulaR1C1 = "=RC[-4]&"" ""&RC[-3]&"" ""&RC[-2]&"" ""&RC[-1]"
    Range("J2:J" & DerLig_T2).Value = Range("J2:J" & DerLig_T2).Value
 
    For i = 2 To DerLig_T2
        If Cells(i, "J") = Cells(i + 1, "J") And Cells(i, "J") = Cells(i + 2, "J") And _
        Cells(i, "J") = Cells(i + 3, "J") And Cells(i, "J") = Cells(i + 4, "J") Then
        End If
    Next i
 
    'Recherche dans le tableau 1
    With Columns(10)
        Set o = .Find(" ")
        If Not o Is Nothing Then
            o_Adr = o.Address
            Do
                Cells(o.Row, "K").FormulaArray = "=IFERROR(IF(RC[-1]<>"""",MATCH(RC10,R1C1:R" & DerLig_T1 & "C1&"" ""&R1C2:R" & DerLig_T1 & "C2&"" ""&R1C3:R" & DerLig_T1 & "C3&"" ""&R1C4:R" & DerLig_T1 & "C4,0),""""),"""")"
                If Cells(o.Row, "K").Value = "" Then
                    Cells(o.Row, "K").Value = "non"
                Else
                    Cells(o.Row, "K").Value = "oui"
                End If
                Set o = .FindNext(o)
            Loop While Not o Is Nothing And o_Adr <> o.Address
        End If
    End With
 
    'Suppression des "oui" consécutifs
    Cpt = 1
    For i = DerLig_T2 To 2 Step -1
        If Cpt < 5 Then
           If Cells(i, "K") = "oui" And Cells(i - 1, "K") = "oui" Then
                Cells(i, "K") = ""
                Cpt = Cpt + 1
           Else
                Cpt = 1
           End If
        Else
            Cpt = 1
        End If
    Next i
 
    'Suppression des "non" consécutifs
    For i = DerLig_T2 To 2 Step -1
        If Cells(i, "K") = "non" And Cells(i - 1, "K") = "non" Then Cells(i, "K") = ""
    Next i
 
    Columns(10).ClearContents
    Set o = Nothing
End Sub

**chloe74** · 28/07/2020, 12h52

[QUOTE=ARTURO83;11599804]Ok, j'avais mal compris, essayez ceci

il y a un petit problème, j'ai essayer cela à fonctionner puis j'ai effacer la ligne 1-2-3-5 et j'ai lancé la macro mais au lieu d'écrire "non" à coté elle écrit "oui" "non" et "oui",
voici la feuille excel devlopez_forum.xlsm
merci

**ARTURO83** · 28/07/2020, 13h49

Ceci est-il moieux?

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
Sub Marquage()
    Dim DerLig_T1 As Long, DerLig_T2 As Long, i As Long, Cpt As Long
    Dim o As Object, n As Object
    Application.ScreenUpdating = False
    Columns(11).ClearContents
    'Contrôle de la présence de 5 lignes identiques du tableau 2
    DerLig_T1 = Columns("A").Find(What:="*", SearchDirection:=xlPrevious).Row
    DerLig_T2 = Columns("F").Find(What:="*", SearchDirection:=xlPrevious).Row
    Set T2 = Range("F2:I" & DerLig_T2)
    Range("J2:J" & DerLig_T2).FormulaR1C1 = "=RC[-4]&"" ""&RC[-3]&"" ""&RC[-2]&"" ""&RC[-1]"
    Range("J2:J" & DerLig_T2).Value = Range("J2:J" & DerLig_T2).Value
 
    'Recherche dans le tableau 1
    With Columns(10)
        Set o = .Find(" ")
        If Not o Is Nothing Then
            o_Adr = o.Address
            Do
                Cells(o.Row, "K").FormulaArray = "=IFERROR(IF(RC[-1]<>"""",MATCH(RC10,R1C1:R" & DerLig_T1 & "C1&"" ""&R1C2:R" & DerLig_T1 & "C2&"" ""&R1C3:R" & DerLig_T1 & "C3&"" ""&R1C4:R" & DerLig_T1 & "C4,0),""""),"""")"
                If Cells(o.Row, "K").Value = "" Then
                    Cells(o.Row, "K").Value = "non"
                Else
                    Cells(o.Row, "K").Value = "oui"
                End If
                Set o = .FindNext(o)
            Loop While Not o Is Nothing And o_Adr <> o.Address
        End If
    End With
 
    'Suppression des "oui" consécutifs
    For i = 2 To DerLig_T2 - 5
       If Cells(i, "K") = "oui" And Cells(i + 1, "K") = "oui" And Cells(i + 2, "K") = "oui" And Cells(i + 3, "K") = "oui" And Cells(i + 4, "K") = "oui" Then
            Range(Cells(i + 1, "K"), Cells(i + 4, "K")) = ""
            i = i + 4
       Else
            Cells(i, "K") = ""
       End If
    Next i
 
    'Suppression des "non" consécutifs
    For i = DerLig_T2 To 2 Step -1
        If Cells(i, "K") = "non" And Cells(i - 1, "K") = "non" Then Cells(i, "K") = ""
    Next i
 
    Columns(10).ClearContents
    Set o = Nothing
End Sub

**chloe74** · 28/07/2020, 15h35

[QUOTE=ARTURO83;11599866]Ceci est-il moieux?

il n'affiche plus de réponse pour le bloc 2 ( ligne 6 à 10 ) et j'ai enlever encore une ligne contenant 1-2-3-4 et il m'affiche quand même "oui" :/

**ARTURO83** · 28/07/2020, 16h00

Montrez-moi ce cas de figure

En attendant , ceci:

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
Sub Marquage()
    Dim DerLig_T1 As Long, DerLig_T2 As Long, i As Long, Cpt As Long
    Dim o As Object, n As Object
    Application.ScreenUpdating = False
    Columns(11).ClearContents
    'Contrôle de la présence de 5 lignes identiques du tableau 2
    DerLig_T1 = Columns("A").Find(What:="*", SearchDirection:=xlPrevious).Row
    DerLig_T2 = Columns("F").Find(What:="*", SearchDirection:=xlPrevious).Row
    Set T2 = Range("F2:I" & DerLig_T2)
    Range("J2:J" & DerLig_T2).FormulaR1C1 = "=RC[-4]&"" ""&RC[-3]&"" ""&RC[-2]&"" ""&RC[-1]"
    Range("J2:J" & DerLig_T2).Value = Range("J2:J" & DerLig_T2).Value
 
    'Recherche dans le tableau 1
    With Columns(10)
        Set o = .Find(" ")
        If Not o Is Nothing Then
            o_Adr = o.Address
            Do
                Cells(o.Row, "K").FormulaArray = "=IFERROR(IF(RC[-1]<>"""",MATCH(RC10,R1C1:R" & DerLig_T1 & "C1&"" ""&R1C2:R" & DerLig_T1 & "C2&"" ""&R1C3:R" & DerLig_T1 & "C3&"" ""&R1C4:R" & DerLig_T1 & "C4,0),""""),"""")"
                If Cells(o.Row, "K").Value = "" Then
                    Cells(o.Row, "K").Value = "non"
                Else
                    Cells(o.Row, "K").Value = "oui"
                End If
                Set o = .FindNext(o)
            Loop While Not o Is Nothing And o_Adr <> o.Address
        End If
    End With
 
    'Suppression des "oui" consécutifs
    For i = 2 To DerLig_T2 - 5
       If Cells(i, "K") = "oui" And Cells(i + 1, "K") = "oui" And Cells(i + 2, "K") = "oui" And Cells(i + 3, "K") = "oui" And Cells(i + 4, "K") = "oui" Then
            Range(Cells(i + 1, "K"), Cells(i + 4, "K")) = ""
            i = i + 4
       Else
            Cells(i, "K") = ""
       End If
    Next i
 
    'Suppression des "non" consécutifs
    For i = DerLig_T2 To 2 Step -1
        If Cells(i, "K") = "non" And Cells(i - 1, "K") = "non" Then Cells(i, "K") = ""
    Next i
 
    Columns(10).ClearContents
    Set o = Nothing
End Sub

**chloe74** · 28/07/2020, 16h39

[QUOTE=ARTURO83;11599960]Montrez-moi ce cas de figure

toujours le même problème :s
voici la feuille excel : devlopez_forum (1).xlsm

**ARTURO83** · 28/07/2020, 18h05

Vous me retourné le fichier sans préciser le résultat attendu, j'en ai besoin pour voir ou se situe le problème.
mettez des commentaires dans vos retours

**chloe74** · 28/07/2020, 18h54

Envoyé par ARTURO83

Vous me retourné le fichier sans préciser le résultat attendu, j'en ai besoin pour voir ou se situe le problème.
mettez des commentaires dans vos retours

oui désolé voici le fichier avec les commentaires : devlopez_forum (1).xlsm

**ARTURO83** · 29/07/2020, 04h39

Bonjour,

Quelque chose m'échappe dans le raisonnement à suivre, j'ai crû comprendre que si les données de 5 lignes consécutives du tableau 2 se trouvent n'importe ou dans le tableau 1 , alors on affiche un "oui" sur la première ligne et rien sur les 4 suivantes, puis on saute ce bloc de 5 lignes pour reprendre le test à la 6ème. Hors, dans votre fichier en retour, on trouve bien le premier "oui" à la ligne 4 (puisqu'il y a bien 5 lignes consécutives qu'on retrouve dans le tableau 1), puis en suivant le raisonnement, on devrait refaire le test à partir de la ligne 9, mais on retrouve un 2ème "oui" à la ligne 7, Pourquoi?

Pour le 1er "non" c'est corrigé.
Pièce jointe 576089

**chloe74** · 29/07/2020, 12h10

Envoyé par ARTURO83

Bonjour,

Quelque chose m'échappe dans le raisonnement à suivre, j'ai crû comprendre que si les données de 5 lignes consécutives du tableau 2 se trouvent n'importe ou dans le tableau 1 , alors on affiche un "oui" sur la première ligne et rien sur les 4 suivantes, puis on saute ce bloc de 5 lignes pour reprendre le test à la 6ème. Hors, dans votre fichier en retour, on trouve bien le premier "oui" à la ligne 4 (puisqu'il y a bien 5 lignes consécutives qu'on retrouve dans le tableau 1), puis en suivant le raisonnement, on devrait refaire le test à partir de la ligne 9, mais on retrouve un 2ème "oui" à la ligne 7, Pourquoi?

Pour le 1er "non" c'est corrigé.
Pièce jointe 576089

Bonjour,
je vois d'ou vient l’erreur, les différentes "bloc" ne peuvent pas être mélanger, lignes 2 à 6 vérifier et dire "oui" ou "non" puis on passe à la ligne 7 à 11 etc,
chaque bloc sont à traité à parts, je mis en couleur les différents blocs : chloe74_recherche de données_1 (1).xlsm
c'est pour cela que ligne 7 il y a un "oui", les "oui" ou "non" apparaissent à la première ligne du bloc donc ici ligne 2; 7; 12
merci

**ARTURO83** · 29/07/2020, 12h32

Ok, je comprends mieux

le fichier
Pièce jointe 576115

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
35
36
Sub Marquage()
    Dim DerLig_T1 As Long, DerLig_T2 As Long, i As Long, Cpt As Long
    Dim o As Object, n As Object
    Application.ScreenUpdating = False
    Columns(11).ClearContents
    'Contrôle de la présence de 5 lignes identiques du tableau 2
    DerLig_T1 = Columns("A").Find(What:="*", SearchDirection:=xlPrevious).Row
    DerLig_T2 = Columns("F").Find(What:="*", SearchDirection:=xlPrevious).Row
    Set T2 = Range("F2:I" & DerLig_T2)
    Range("J2:J" & DerLig_T2).FormulaR1C1 = "=RC[-4]&"" ""&RC[-3]&"" ""&RC[-2]&"" ""&RC[-1]"
    Range("J2:J" & DerLig_T2).Value = Range("J2:J" & DerLig_T2).Value
 
    'Recherche dans le tableau 1
    With Columns(10)
        Set o = .Find(" ")
        If Not o Is Nothing Then
            o_Adr = o.Address
            Do
                Cells(o.Row, "K").FormulaArray = "=IFERROR(IF(RC[-1]<>"""",MATCH(RC10,R1C1:R" & DerLig_T1 & "C1&"" ""&R1C2:R" & DerLig_T1 & "C2&"" ""&R1C3:R" & DerLig_T1 & "C3&"" ""&R1C4:R" & DerLig_T1 & "C4,0),""""),"""")"
                If Cells(o.Row, "K").Value = "" Then
                    Cells(o.Row, "K").Value = "non"
                Else
                    Cells(o.Row, "K").Value = "oui"
                End If
                Set o = .FindNext(o)
            Loop While Not o Is Nothing And o_Adr <> o.Address
        End If
    End With
 
    For i = 2 To DerLig_T2 - 4 Step 5
        Range(Cells(i + 1, "K"), Cells(i + 4, "K")) = ""
    Next i
 
    Columns(10).ClearContents
    Set o = Nothing
End Sub

**chloe74** · 29/07/2020, 13h05

[QUOTE=ARTURO83;11600310]Ok, je comprends mieux

j'ai essayé votre macro, elle a un problème car lorsque j’enlève une ligne par exemple 1-3-4-5 alors il me marque "oui" alors qu'il ne devrait pas, j'ai remarquée que la valeur "oui" ne dépend que de la premier ligne d'un bloc alors qu'il doit dépendre des 5 lignes du bloc, on voit sur le fichier ci-joint que il n'y a pas les 5 lignes dans le tableau 1 mais il marque "oui" et si l'on supprime la premier ligne du bloc ( soit 2 soit 7 soit 12 ) alors la il met "non"
voici le fichier : chloe74_recherche de données_2 (1).xlsm

**ARTURO83** · 29/07/2020, 16h22

Je suis passé à côté, ceci devrait aller

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
Sub Marquage()
    Dim DerLig_T1 As Long, DerLig_T2 As Long, i As Long, Cpt As Long
    Dim o As Object, n As Object
    Application.ScreenUpdating = False
    Columns(11).ClearContents
    'Contrôle de la présence de 5 lignes identiques du tableau 2
    DerLig_T1 = Columns("A").Find(What:="*", SearchDirection:=xlPrevious).Row
    DerLig_T2 = Columns("F").Find(What:="*", SearchDirection:=xlPrevious).Row
    Set T2 = Range("F2:I" & DerLig_T2)
    Range("J2:J" & DerLig_T2).FormulaR1C1 = "=RC[-4]&"" ""&RC[-3]&"" ""&RC[-2]&"" ""&RC[-1]"
    Range("J2:J" & DerLig_T2).Value = Range("J2:J" & DerLig_T2).Value
 
    'Recherche dans le tableau 1
    With Columns(10)
        Set o = .Find(" ")
        If Not o Is Nothing Then
            o_Adr = o.Address
            Do
                Cells(o.Row, "K").FormulaArray = "=IFERROR(IF(RC[-1]<>"""",MATCH(RC10,R1C1:R" & DerLig_T1 & "C1&"" ""&R1C2:R" & DerLig_T1 & "C2&"" ""&R1C3:R" & DerLig_T1 & "C3&"" ""&R1C4:R" & DerLig_T1 & "C4,0),""""),"""")"
                If Cells(o.Row, "K").Value = "" Then
                    Cells(o.Row, "K").Value = "non"
                Else
                    Cells(o.Row, "K").Value = "oui"
                End If
                Set o = .FindNext(o)
            Loop While Not o Is Nothing And o_Adr <> o.Address
        End If
    End With
 
    For i = 2 To DerLig_T2 - 4 Step 5
        If Cells(i, "K") = "oui" And Cells(i + 1, "K") = "oui" And Cells(i + 2, "K") = "oui" And Cells(i + 3, "K") = "oui" And Cells(i + 4, "K") = "oui" Then
            Range(Cells(i + 1, "K"), Cells(i + 4, "K")) = ""
        Else
            Range(Cells(i + 1, "K"), Cells(i + 4, "K")) = ""
            Cells(i, "K") = "non"
        End If
    Next i
 
    Columns(10).ClearContents
    Set o = Nothing
End Sub

**chloe74** · 29/07/2020, 20h42

[QUOTE=ARTURO83;11600414]Je suis passé à côté, ceci devrait aller

merci ! elle je l'ai essayer et elle n'a pas eu de soucis,
bonne soirée a vous

**Alex020181** · 30/07/2020, 03h22

Bonjour,

Voici une manière de faire.

Vous trouverez un fichier en PJ qui reprend votre exemple auquel est ajouté ma proposition de code pour faire les comparaisons voulues.

Vous avez un bouton sur la feuille.

Cela vous convient ?

**Alex020181** · 30/07/2020, 03h26

Pour l'exemple j'ai repris votre fichier mais vous pouvez ajouter autant de lignes que souhaitées. La recherche sera rapide.

recherche de données

Excel

Discussions similaires

Partager

Partager