double condition (avec des for each)

Version imprimable

Bonjour à tous de nouveau,

voilà, j'ai fait ce code qui est censé me donner une msgbox quand les deux conditions sont réunies. Malheureusement, cela n'a pas l'air de fonctionner. Il ne plante pas, mais il affiche la première msgbox sans que la deuxième condition (second for each) ne soit faite.

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
44
 
Sub Bouton_valider_S()
 
Dim i As Long
Dim j As Long
Dim maxtab As Long
Dim Plage As Range
Dim c As Range
Dim d As Range
Dim dte As String
Dim C1 As Workbook
    Set C1 = ActiveWorkbook
Dim f As Worksheet
    Set f = C1.Worksheets("Feuil1")
Dim Accueil As Worksheet
 
'défini la plage de recherche
    With Worksheets("Feuil1")
        Set Plage = .Range(.[A1], .[G65536].End(xlUp))
    End With
 
'valeur cherchée
dte = sheets("Accueil").[G12].Value
 
Application.ScreenUpdating = False
 
sheets("Feuil1").Select
 
Dim k As Integer
k = ActiveSheet.UsedRange.Rows.Count
 
    For Each c In f.Range("A2:A" & k)
        If c Like dte Then
            For Each d In f.Range("C2:C" & k)
                        If d = "SECURITE" Then
                            MsgBox "Un audit à déjà été validé à cette date. Merci de bien vouloir saisir une autre date.", vbInformation
                            sheets("Accueil").Select
                            Range("G12").Select
                            Application.ScreenUpdating = True
                            Exit Sub
                        End If
            Next
        End If
    Next

Ca doit surement êttre bancal, mais pour moi ça me semblait plus ou moins logique :pastaper:

Merci

Flo

recherche

Bonsoir FloFlosu, Bonsoir le Forum,

Je crains que tu t'y prennes de la mauvaise façon.

Ton 2ème balayage n'a aucun rapport avec le premier.

Tu as 2 solutions

- Double Filtre : le plus simple; je te laisse executer le code à l'aide de l'enregistreur, que tu purgeras ensuite.

- Filtre dans ton occurence de date, et balayage de toutes les lignes visibles
pour capter celle qui répond à ton critère (sécurité)

A adapter (ligne, colonne, nom, ...)
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 Sub Macro1() Dim trouve As Boolean Dim cel As Range If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData Selection.AutoFilter Field:=1, Criteria1:=Range("F1").Value trouve = False For Each cel In Range("B:B").SpecialCells(xlCellTypeVisible) If cel.Value = "sécurité" Then MsgBox "Trouvé en " & cel.Address trouve = True Exit For End If Next If trouve = False Then MsgBox "Pas trouvé" End Sub

bonjour à tous,

merci Marcel de m'avoir répondu. Toutefois, la nuit portant généralement conseil, d'une part je me suis rendu compte de mon erreur :ccool: , d'autre part, j'ai finalement trouvé la solution qui me convenait.
Je la poste au cas où ça pourrait servir à quelqu'un.

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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
 
Dim i As Long
Dim j As Long
Dim maxtab As Long
Dim Plage As Range
Dim c As Range
Dim d As Long
Dim dte As String
Dim C1 As Workbook
    Set C1 = ActiveWorkbook
Dim f As Worksheet
    Set f = C1.Worksheets("Feuil1")
Dim Accueil As Worksheet
 
'défini la plage de recherche
    With Worksheets("Feuil1")
        Set Plage = .Range(.[A1], .[G65536].End(xlUp))
    End With
 
'valeur cherchée
dte = sheets("Accueil").[G12].Value
 
Application.ScreenUpdating = False
 
sheets("Feuil1").Select
 
Dim k As Integer
k = ActiveSheet.UsedRange.Rows.Count
 
    'pour chaque cellule c dans la colonne A
    For Each c In f.Range("A2:A" & k)
        'si il existe une valeur égale à celle de dte alors
        If c Like dte Then
            'on copie le numéro de la ligne dans la variable d
            d = c.Row
            'et si dans la cellule de la colonne C, sur la ligne trouvée on repère la valeur QUALITE alors...
            If Range("C" & d).Value = "QUALITE" Then
                MsgBox "Un audit à déjà été validé à cette date. Merci de bien vouloir saisir une autre date.", vbInformation
                sheets("Accueil").Select
                Range("G12").Select
                Application.ScreenUpdating = True
                Exit Sub
            End If
        End If
    Next
 
    'sinon pour chaque cellule c dans la colonne A
    For Each c In f.Range("A2:A" & k)
        'si il existe une valeur supérieure à celle de dte alors...
        If c > dte Then
                MsgBox "La date de votre audit est antérieur à celle du dernier audit réalisé " & "(" & c & ")." & " Merci de bien vouloir rentrer une autre date.", vbInformation
                sheets("Accueil").Select
                Range("G12").Select
                Application.ScreenUpdating = True
                Exit Sub
        End If
    Next
 
 
'sinon....