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