Bonjour,

je viens de m'inscrire sur ce forum et je sollicite votre aide pour améliorer mon script.
Mon projet est de savoir combien j'ai de personnes dans un bâtiment, on badge en entrant et sortant.
Dans le script ci dessous, je log dans un fichier la valeur max d'entrée dans le bâtiment pour chaque personne.
Ce que j'aimerai c est ajouté une inputBox où la je pourrai choisir l'heure à laquelle je souhaite connaître le nombre de personne dans le bâtiment
au format hh:mm:ss avec masque de saisie pour éviter des anomalies et si la personne entre par exemple

"10:" pour 10h ca ajoute des 0 pour les minutes et secondes.

Aujourd'hui mon script est : (çà fonctionne mais pas d'heure max en variable, la recherche se fait sur toute ma liste....)

Merci d'avance

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
Sub Badge_IN()
'suppression des alertes
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'declaration des variables
Dim test1 As String
Dim Der1 As Long
Dim der2 As Long
Dim Derlig As Long
 
'Nombre de lignes totales des onglets Badge et Vendredi
Der1 = Worksheets("Badge").Range("A2").End(xlDown).Row
der2 = Worksheets("vendredi").Range("A2").End(xlDown).Row
 
For i = 2 To Der1
'nettoyage fichier Temporaire
Worksheets("TEMP").Range("A1:C5000").ClearContents
Worksheets("vendredi").Cells(1, "C").EntireRow.Copy Destination:=Worksheets("TEMP").Range("A1")
'Recherche pour chaque badge
test1 = Worksheets("badge").Cells(i, "A").Value
For j = 2 To der2
'si le badge est trouver dans la feuille vendredi et la valeur est "IN" alors copie des cellules dans TEMP
If Worksheets("vendredi").Cells(j, "C").Value = test1 And Worksheets("vendredi").Cells(j, "B").Value = "IN" Then
Worksheets("TEMP").Range("A" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("vendredi").Cells(j, "A").Value
Worksheets("TEMP").Range("B" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("vendredi").Cells(j, "B").Value
Worksheets("TEMP").Range("C" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("vendredi").Cells(j, "C").Value
End If
Next j
Derlig = Worksheets("TEMP").Range("A2").End(xlDown).Row
'Valeur max pour chaque badge dans colonne K
Sheets("badge").Range("K" & i).Value = Format(Application.Max(Sheets("TEMP").Range("A2:A" & Derlig)), "hh:mm:ss")
Next i
 
'retour des alertes
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Je débute en VBA