Discussion :

[fullmetalknet]

Bonjour à tous,

Je souhaiterais faire une recherche de doublon par rapport a plusieurs colonnes puis en créer une alerte type msgbox

J'explique mon cas, dans un tableau d'historique je souhaiterais ressortir un msgbox si deux meme pannes ont été effectuer dans un mois.

Pour cela, j'ai dans la colonne
A - la date de l'intervention
colonne D - Corrective
Colonne E - Type de panne
et Colonne J - machine n

Es ce que c'est possible de faire cela avec autant de conditions?

merci d'avance

[jp014]

Bonjour

Question
Quel est le contenu de la colonne D ?
Comment sont identifié les dysfonctionnements du système colonne E.


Jp

[fullmetalknet]

tout d'abord merci de prendre de ton temps pour moi!

le contenu de la colone D est "CORRECTIVE" et "PREVENTIVE" je souhaites faire des alertes que sur le correctif!

les dysfonctionnements colonne E sont incrementés par une liste donc pas de soucis d'erreur de frappe

colonne J idem a colonne E

[jp014]

Bonsoir

Un code à tester.
Principe
Sélection d'une machine
Recherche dans les lignes suivantes le nom de la machine
Contrôle = type de maintenance
type d'intervention
vérification si l'intervention est dans les 31 derniers jours
affichage d'un message

N'ayant pas de données mes tests ont été limité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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
Option Explicit
 
Sub travdem()
' pour boucler sur la colonne 1
Dim cellule As Range
Dim nomfeuille1 As String
Dim lig As Long, dl1 As Long
 
nomfeuille1 = "Feuil1"
 
With Sheets(nomfeuille1)
dl1 = .Cells(.Rows.Count, 10).End(xlUp).Row
 
For Each cellule In Sheets(nomfeuille1).UsedRange.Columns(10).Cells
 
If cellule.Offset(0, -6) = "Corrective" Then
lig = cellule.Row + 1
    Do
        lig = recherchemot("i" & lig + 1 & ":j" & dl1+1, cellule.Value, nomfeuille1, 1, "string")
        If lig = 0 Then Exit Do
        ' on vérifie le type de maintenance
        If .Range("D" & lig) = cellule.Offset(0, -6) Then
            If .Range("E" & lig) = cellule.Offset(0, -5) Then
 
                If DateDiff("d", cellule.Offset(0, -9), .Range("a" & lig)) <= 31 Then
 
                Select Case MsgBox("La machine                   :" & cellule.Value _
                                   & vbCrLf & "est tombé en panne le  :" & cellule.Offset(0, -9) _
                                   & vbCrLf & "                            et le  :" & .Range("a" & lig) _
                                   & vbCrLf & "Dysfonctionnement      :" & .Range("E" & lig) _
                                   & vbCrLf & "Nombre de jours          :" & DateDiff("d", cellule.Offset(0, -9), .Range("a" & lig)) _
                                   & vbCrLf & "" _
                                   & vbCrLf & "" _
                                   , vbOKCancel Or vbExclamation Or vbDefaultButton1, Application.Name)
 
                    Case vbOK
                            exit do
                    Case vbCancel
                        Exit Sub
                End Select
 
                End If
            End If
        End If
    Loop
End If
Next cellule
End With
End Sub
 
Function recherchemot(plage_recherche As String, valcherche As Variant, nom_de_la_feuille As String, code_retour As Byte, £typrecherche As String)
Dim £cel As Range
Dim £i As Integer
Dim £trouve As Boolean
 
With Sheets(nom_de_la_feuille).Range(plage_recherche)
    Select Case £typrecherche
     Case "string"
        Set £cel = .Find(valcherche, LookIn:=xlValues, SearchOrder:=xlByColumns, lookat:=xlWhole) ' on recherche ligne par ligne
    Case "date"
        Set £cel = .Find(valcherche, LookIn:=xlFormulas, SearchOrder:=xlByRows) 'si date
    Case "partiel"
        Set £cel = .Find(valcherche, LookIn:=xlValues, SearchOrder:=xlByColumns, lookat:=xlPart) ' on recherche ligne par ligne
    End Select
   'Set £c = .Find(dataf, LookIn:=xlValues, MatchCase:=True,SearchOrder:=xlByRows, lookat:=xlWhole)
    If Not £cel Is Nothing Then £trouve = True
End With
If £trouve = True Then
    If code_retour = 1 Then recherchemot = £cel.Row ' ligne
 
Else
    If code_retour = 1 Then recherchemot = 0
End If
End Function

JP014

[fullmetalknet]

L'idée est là!!

c'est exactement ce que je voulais!

par contre j'ai remarqué un petit bug quand on fait ok de la msgbox

il me met un msgbox alors qu'elle n'y est qu'une seule fois et la msgbox ne s'arrete jamais

peut etre une solution a ce probleme?

merci beaucoup JP014

[jp014]

Bonjour

N'ayant pas de données à tester, mon test à été très sommaire.
Effectivement il n'y a pas de sortie de boucle.
Ci dessous le code à rajouter (en rouge)

Code :

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

1
2
3
4
5
                     Case vbOK
                         exit do
                    Case vbCancel
                        Exit Sub
                End Select

Il est possible de sortir du message en cliquant sur annuler, cela évite de parcourir toute la base une fois que l'on a trouvé l'information.

Le code est facilement modifiable pour éventuellement choisir une machine.

JP014

[fullmetalknet]

Parfait!

Pour le petit bug je met en pieces jointes des captures d'ecrans
donc tu verra il me sort bien l'alerte pour le poste A car il y a 2 pannes dans moins d'un mois, mais après il me sort une alerte pour le poste B alors qu'il n'y a qu'une seule pannes

[jp014]

Bonjour

Pour éliminer ce problème qui se produit à la dernière ligne écrite, il suffit d'ajouter "+1" à la ligne suivante.

Code :

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

lig = recherchemot("i" & lig + 1 & ":j" & dl1 + 1, cellule.Value, nomfeuille1, 1, "string")

De cette manière on aura une inégalité et la fonction retournera la valeur 0 ce qui permet de sortir de la boucle.
JP014

[fullmetalknet]

Chapeau bas l'artiste, je n'aurais pas trouver l'erreur!

Merci beaucoup pour ton aide et ta rapidité
et d'avoir passer du temps pour moi

encore merci
A+