Bonjour à tous,
 
je veux faire un script en VBA :
si je saisie une date(x) à quelle heure "Entrée 1" a été mise en marche et à quelle heure elle a été arrêtée.
si je saisie une date(x) à quelle heure le "ok" a débuté et à quelle heure il a pris fin.
je voudrais avoir une macro pour chacun si possible.
 
 
 
22/11/2012
07:26:29  ---- Mise en marche --- Entree 1 --- MARCHE
22/11/2012
16:26:31  ---- Mise en marche ---Entree 1 --- ARRET
 
22/11/2012
07:26:50          ok
22/11/2012
16:26:56        ok  
22/11/2012
16:26:59            ok  
22/11/2012
16:27:02          ok  
22/11/2012
16:27:04          ok  
22/11/2012
16:27:12          ok  
22/11/2012
16:27:14               ok  
22/11/2012
16:27:16              ok  
22/11/2012
16:27:18                ok  
22/11/2012
16:27:20            ok
 
cordialement

J'ai trouvé une solution à mon problème, je vous met le code au cas ou xa interesserait quelqu'un :
 
Private Sub CommandButton1_Click()
Dim m As Integer, Date_Réf As Date, Ligne_fin As Integer, Date_Réf_Col As Integer, Date_Réf_Lig As Integer
Dim Réf_Marche As String, Réf_Arrêt As String, Réf_Ok_Début As String, Réf_Ok_Fin As String
 
Application.ScreenUpdating = False
Ligne_fin = Range("A1048576" ).End(xlUp).Row
 
On Error GoTo Etiquette
Date_Réf = InputBox("Quelle est la date choisie ?" )
Etiquette:
If Date_Réf = 0 Then
    MsgBox ("La saisie n'est pas une date" )
    Exit Sub
End If
 
Range("A17" ).Activate
 
Do Until ActiveCell = Date_Réf
    ActiveCell.Offset(1, 0).Activate
    If ActiveCell.Row = Ligne_fin + 10 Then
        MsgBox ("Date introuvable" )
        Exit Sub
    End If
Loop
 
Date_Réf_Col = ActiveCell.Column
Date_Réf_Lig = ActiveCell.Row
 
On Error Resume Next
 
Do
m = 0
m = WorksheetFunction.Search("Entree 1 --- MARCHE", ActiveCell.Offset(1, 0))
If m > 0 Then Réf_Marche = Left(ActiveCell.Offset(1, 0), 8)
ActiveCell.Offset(1, 0).Activate
Loop Until m > 0
 
Cells(Date_Réf_Lig, Date_Réf_Col).Activate
Do
m = 0
m = WorksheetFunction.Search("Entree 1 --- ARRET", ActiveCell.Offset(1, 0))
If m > 0 Then Réf_Arrêt = Left(ActiveCell.Offset(1, 0), 8)
ActiveCell.Offset(1, 0).Activate
Loop Until m > 0
 
Cells(Date_Réf_Lig, Date_Réf_Col).Activate
Do
m = 0
m = WorksheetFunction.Search("---- ON ----", ActiveCell.Offset(1, 0))
If m > 0 Then Réf_Ok_Début = Left(ActiveCell.Offset(1, 0), 8)
ActiveCell.Offset(1, 0).Activate
Loop Until m > 0
 
 
'On part à l'envers pour la dernière référence
Range("A" & Ligne_fin).Activate
 
Do Until ActiveCell = Date_Réf
    ActiveCell.Offset(-1, 0).Activate
Loop
 
Do
m = 0
m = WorksheetFunction.Search("---- ON ----", ActiveCell.Offset(1, 0))
If m > 0 Then Réf_Ok_Fin = Left(ActiveCell.Offset(1, 0), 8)
ActiveCell.Offset(-1, 0).Activate
Loop Until m > 0
 
MsgBox (Date_Réf & vbNewLine & vbNewLine & "Mise en marche : " & vbNewLine & Réf_Marche & vbNewLine & vbNewLine & "Arrêt : " & vbNewLine & Réf_Arrêt & vbNewLine & vbNewLine & "Début Production : " & vbNewLine & Réf_Ok_Début & vbNewLine & vbNewLine & " Fin Production : " & vbNewLine & Réf_Ok_Fin)
 
End Sub
 
 
cordialement