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 |
Extraire des données dans un tableau
Répondre avec citation
c'est toujours apprécié...
)
Envoyé par ARTURO83
Partager