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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
| Public Sub modif()
Dim oFSO As FileSystemObject 'objet de gestion de fichiers
Dim oShR As Worksheet 'onglet résultat
Dim sRep As String 'chemin du répertoire principal
Dim oRep As Folder 'objet répertoire
Dim oFic As File 'objet fichier
Dim oWBx As Workbook 'classeur excel à importer (plusieurs)
Dim oShx As Worksheet 'onglet du classseur à importer
Dim iDerLig As Integer 'dernière ligne
Dim Nom_Fichie() As String
Dim Z As Integer
Dim C As Integer
Dim A As Integer
Dim Y As Integer
Dim X As Integer
Dim MOYENNE As Long
Dim MaPlage As Range
'sélection du répertoire à importer
sRep = ChoixDossier()
'si l'utilisateur annule la recherche, on arrête
If sRep = "" Then
Exit Sub
End If
'instanciation des objets
Set oFSO = New FileSystemObject 'objet de gestion de fichier
Set oRep = oFSO.GetFolder(sRep) 'objet répertoire
Set oShR = Workbooks("ConcatenerDonnees-v1.xlsm").Worksheets("Resultat") 'onglet résultat
'bloque la mise à jour de l'affichage (accélère le traitement)
Application.ScreenUpdating = False
'bloque les alerte système (boite de dialogue du genre "voulez vous enregistrer le document?")
Application.DisplayAlerts = False
'parcours de tous les fichiers du répertoire
For Each oFic In oRep.Files
'prend en compte tous les fichiers avec un nom "[diagramme ] ..... [° du collecteur.xlsx]"
If Left(oFic.Name, 9) = "diagramme " And Right(oFic.Name, 20) = "° du collecteur.xlsx" Then
'ouverture du fichier
Set oWBx = Workbooks.Open(oFic.Path, , True)
'premier onglet du fichier
Set oShx = oWBx.Worksheets(1)
'dernière ligne du fichier
iDerLig = oShx.Range("I" & Rows.Count).End(xlUp).Row
'convertis les valeurs de chaque ligne en valeur réelle
C = iDerLig + 2
For Z = 4 To iDerLig
Cells(C, 9) = 10 ^ ((-Cells(Z, 9)) / 10)
C = C + 1
Next
'donne le début de la série des valeurs réelles
A = iDerLig + 2
'calcul de la moyenne des valeurs réelle qui est convertie en dB
MOYENNE = Application.Average(Range(Cells(A, 9), Cells(C, 9)))
Cells(8200, 9) = 10 * Application.WorksheetFunction.Log10(MOYENNE)
'calcul du nombre de valeurs suppérieur à -10,-11,-12,-13,..,-20
Y = 10
For X = 8205 To 8215
'cellule(x,I)=appliquer formule (=NB.SI(I$4:I$4099;">-y"))
Set MaPlage = Range("I4:I4099")
Cells(X, 9) = Application.CountIf(MaPlage, ">-" & Y)
Y = Y + 1
Next
oWBx.Save
'désinstanciation de l'objet
Set oShx = Nothing
'fermeture du fichier
oWBx.Close
'désinstanciation de l'objet
Set oWBx = Nothing
End If
Next oFic
'mise à jour de l'affichage
Application.ScreenUpdating = True
'remet les alertes
Application.DisplayAlerts = True
'désinstanciation des objets
Set oShR = Nothing
Set oRep = Nothing
Set oFSO = Nothing
End Sub |
macro fais un enregistrement (surtout pas enregistrement sous)
Répondre avec citation
pour chaque message ayant aidé puis sur 
pour clore cette discussion.
Envoyé par Jean-Philippe André
Partager