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 75 76 77 78 79 80 81 82
| Sub Recup_T°()
'Déclaration des variables
Dim T1_Min As Double, T2_Min As Double, T3_Min As Double, T4_Min As Double
Dim T1_Max As Double, T2_Max As Double, T3_Max As Double, T4_Max As Double
Dim H_T1_Min As Double, H_T2_Min As Double, H_T3_Min As Double, H_T4_Min As Double
Dim H_T1_Max As Double, H_T2_Max As Double, H_T3_Max As Double, H_T4_Max As Double
Dim i As Long, DerLig As Long, NbJ As Long, LigDeb As Long, LigFin As Long
Dim Jour As Date
Application.ScreenUpdating = False 'Evite les raffraichissements de l'écran et accélère la vitesse d'exécution
DerLig = Cells(Rows.Count, "A").End(xlUp).Row 'recherche de la dernière ligne des relevés de température. La recherche se fait sur la colonne A
LigDeb = 3 'ligne du premier relevé de température
'Marquage par un repère(numéro) en colonne AZ du changement de jour, ceci pour déterminer le nombre(variable) de relevés par jour
[AZ3] = 1 'on commence avec le N°1
Range("AZ4:AZ" & DerLig).FormulaR1C1 = "=IF(RC[-51]<>R[-1]C[-51],R[-1]C+1,R[-1]C)" 'formule d'affectation d'un numéro, reproduite jusqu'à la dernière ligne
Range("AZ4:AZ" & DerLig).Value = Range("AZ4:AZ" & DerLig).Value 'on remplace les formules par les valeurs trouvées
'Nombre de jours de relevés
NbJ = Application.Max(Range("AZ4:AZ" & DerLig))
Lig = 3 'première ligne de récupération des valeurs du tableau de synthèse
Range("J3:Z368").ClearContents 'Effacement des précédents résultats dans le tableau de synthèse
For i = 1 To NbJ 'on teste du premier au dernier jour
Set Prem_Heure = Range("AZ1:AZ" & DerLig).Find(i) 'Détection de la ligne de changement de jour
LigDeb = Prem_Heure.Row 'On affecte ce N° de ligne à la variable LigDeb
j = Prem_Heure.Row 'on l'applique aussi à la variable J
Do While Cells(j + 2, "AZ") = Prem_Heure 'Recherche du dernier relevé du même jour
j = j + 1 'on scrute toutes les cellules de la colonne AZ jusqu'au changement de valeur
Loop 'on recommence tant que la valeur trouvée est identique à Prem_Heure
LigFin = Cells(j, "A").Row 'ligne du dernier relevé
Jour = Cells(j, "A") 'Relevé de la date du jour traité
Capteur1:
'Relevés du premier capteur en colonne C
T1_Min = Application.Min(Range("C" & LigDeb & ":C" & LigFin)) 'Température min
Set T1_mini = Range("C" & LigDeb & ":C" & LigFin).Find(T1_Min, LookIn:=xlFormulas, lookat:=xlWhole)
H_T1_Min = Cells(T1_mini.Row, "B") 'Heure de la température min
T1_Max = Application.Max(Range("C" & LigDeb & ":C" & LigFin)) 'Température max
Set T1_maxi = Range("C" & LigDeb & ":C" & LigFin).Find(T1_Max, LookIn:=xlFormulas, lookat:=xlWhole)
H_T1_Max = Cells(T1_maxi.Row, "B") 'Heure de la température max
Capteur2:
'Relevés du deuxième capteur en colonne D
T2_Min = Application.Min(Range("D" & LigDeb & ":D" & LigFin)) 'Température min
Set T2_Mini = Range("D" & LigDeb & ":D" & LigFin).Find(T2_Min, LookIn:=xlFormulas, lookat:=xlWhole)
If Not T2_Mini Is Nothing Then
H_T2_Min = Cells(T2_Mini.Row, "B") 'Heure de la température min
T2_Max = Application.Max(Range("D" & LigDeb & ":D" & LigFin)) 'Température max
Set T2_maxi = Range("D" & LigDeb & ":D" & LigFin).Find(T2_Max, LookIn:=xlFormulas, lookat:=xlWhole)
H_T2_Max = Cells(T2_maxi.Row, "B") 'Heure de la température max
End If
Capteur3:
'Relevés du troisième capteur en colonne F
T3_Min = Application.Min(Range("F" & LigDeb & ":F" & LigFin)) 'Température min
Set T3_Mini = Range("F" & LigDeb & ":F" & LigFin).Find(T3_Min, LookIn:=xlFormulas, lookat:=xlWhole)
If Not T3_Mini Is Nothing Then
H_T3_Min = Cells(T3_Mini.Row, "B") 'Heure de la température min
T3_Max = Application.Max(Range("F" & LigDeb & ":F" & LigFin)) 'Température max
Set T3_maxi = Range("F" & LigDeb & ":F" & LigFin).Find(T3_Max, LookIn:=xlFormulas, lookat:=xlWhole)
H_T3_Max = Cells(T3_maxi.Row, "B") 'Heure de la température max
End If
Capteur4:
'Relevés du quatrième capteur en colonne H
T4_Min = Application.Min(Range("H" & LigDeb & ":H" & LigFin)) 'Température min
Set T4_Mini = Range("H" & LigDeb & ":H" & LigFin).Find(T4_Min, LookIn:=xlFormulas, lookat:=xlWhole)
If Not T4_Mini Is Nothing Then
H_T4_Min = Cells(T4_Mini.Row, "B") 'Heure de la température min
T4_Max = Application.Max(Range("H" & LigDeb & ":H" & LigFin)) 'Température max
Set T4_maxi = Range("H" & LigDeb & ":H" & LigFin).Find(T4_Max, LookIn:=xlFormulas, lookat:=xlWhole)
H_T4_Max = Cells(T4_maxi.Row, "B") 'Heure de la température max
End If
'Recopie des résultats dans le tableau de synthèse(colonnes de J à Z), (Jour, T°Min, H_T°min, T°max et H_T°max de chaque capteur))
Range(Cells(Lig, "J"), Cells(Lig, "Z")).Value = Array(Jour, T1_Min, H_T1_Min, T1_Max, H_T1_Max, T2_Min, H_T2_Min, T2_Max, H_T2_Max, T3_Min, H_T3_Min, T3_Max, H_T3_Max, T4_Min, H_T4_Min, T4_Max, H_T4_Max)
Lig = Lig + 1 'on passe à la ligne suivante du tableau de synthèse
Next i
Columns("AZ").ClearContents 'on efface le contenu de la colonne AZ
End Sub |
Partager