Discussion :

[FloFlosu]

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 :

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 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

Merci

Flo

[MarcelG]

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 :

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
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

[FloFlosu]

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 , d'autre part, j'ai finalement trouvé la solution qui me convenait.
Je la poste au cas où ça pourrait servir à quelqu'un.

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
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....