histogramme sur chaque feuille de calcul [Résolu]

[Titened]

Bonjour tout le monde !
J'ai créé un programme (souvent avec l'aide de l'enregistreur de macro car mes connaissances sont très basiques). Voilà le déroulement du programme :

1. je crée un classeur excel avec un nom bien spécifique : il dépend du mois, de l'année et du point de mesure :

Code :

1
2
3
4
5
6
mois = Workbooks("courant").Sheets(1).Range("h13") 'nom ou numéro du mois. Cette case est remplie par l'utilisateur qui lance la macro
annee = Workbooks("courant").Sheets(1).Range("h14") 'année Cette case est remplie par l'utilisateur qui lance la macro
pt = Workbooks("courant").Sheets(1).Range("h15") 'A ou B suivant le point de mesure Cette case est remplie par l'utilisateur qui lance la macro
 
Set classeur = Application.Workbooks.Add
classeur.SaveAs ("corr_pt" & pt & "_" & mois & "_" & annee & ".xls")

2. je crée un onglet et défini mon tableau. qui sera comme dans cette exemple :

vitesse 1 vitesse 2 vitesse n

direction 1
direction 2
...
direction k

Code :

1
2
3
4
5
6
7
8
9
For i = 1 To 10
    Sheets.Add.Name = "c " & i 'nouvel onglet... Il est prévu d'en créer 9
        For j = 1 To 36
    Sheets(1).Range("A" & j + 1) = (j - 1) * 10 & "° -" & j * 10 & "°" 'ce qu'il y aurait sur chaque ligne
        Next j
 
        For k = 1 To 15
    Sheets(1).Cells(1, k + 1) = "< " & k * 0.1 & " m/s" 'ce qu'il y aura sur chaque colonne
        Next k

3. Remplissage du tableau. Les données se trouvent dans le classeur "courant", deuxieme feuille. Ce sont des colonnes qui vont de B à U (colonnes 2 à 21). colonnes paires ce sont des vitesses et colonnes impaires ce sont les directions.

Code :

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
        For compt = 2 To derlig
        n = i * 2
        V = Workbooks("courant").Sheets(2).Cells(compt, n).Value
            n = n + 1
        Dirp = Workbooks("courant").Sheets(2).Cells(compt, n).Value
 
    Select Case V
        Case 0 To 0.1: j = 1
        Case 0.1001 To 0.2: j = 2
        Case 0.2001 To 0.3: j = 3
        Case 0.3001 To 0.4: j = 4
        Case 0.4001 To 0.5: j = 5
        Case 0.5001 To 0.6: j = 6
        Case 0.6001 To 0.7: j = 7
        Case 0.7001 To 0.8: j = 8
        Case 0.8001 To 0.9: j = 9
        Case 0.9001 To 1: j = 10
        Case 1.0001 To 1.1: j = 11
        Case 1.1001 To 1.2: j = 12
        Case 1.2001 To 1.3: j = 13
        Case 1.3001 To 1.4: j = 14
        Case 1.4001 To 1.5: j = 15
    End Select
 
 
    Select Case Dirp
        Case 0 To 10: k = 1
        Case 10.001 To 20: k = 2
        Case 20.001 To 30: k = 3
        Case 30.001 To 40: k = 4
        Case 40.001 To 50: k = 5
        Case 50.001 To 60: k = 6
        Case 60.001 To 70: k = 7
        Case 70.001 To 80: k = 8
        Case 80.001 To 90: k = 9
        Case 90.001 To 100: k = 10
        Case 100.001 To 110: k = 11
        Case 110.001 To 120: k = 12
        Case 120.001 To 130: k = 13
        Case 130.001 To 140: k = 14
        Case 140.001 To 150: k = 15
        Case 150.001 To 160: k = 16
        Case 160.001 To 170: k = 17
        Case 170.001 To 180: k = 18
        Case 180.001 To 190: k = 19
        Case 190.001 To 200: k = 20
        Case 200.001 To 210: k = 21
        Case 210.001 To 220: k = 22
        Case 220.001 To 230: k = 23
        Case 230.001 To 240: k = 24
        Case 240.001 To 250: k = 25
        Case 250.001 To 260: k = 26
        Case 260.001 To 270: k = 27
        Case 270.001 To 280: k = 28
        Case 280.001 To 290: k = 29
        Case 290.001 To 300: k = 30
        Case 300.001 To 310: k = 31
        Case 310.001 To 320: k = 32
        Case 320.001 To 330: k = 33
        Case 330.001 To 340: k = 34
        Case 340.001 To 350: k = 35
        Case 350.001 To 360: k = 36
    End Select
 
        Sheets(1).Cells(k + 1, j + 1).Value = Sheets(1).Cells(k + 1, j + 1).Value + 1
 
Next compt

4. je fais une somme ligne par ligne et colonnes par colonnes (merci enregistreur de macro )

Code :

1
2
3
4
5
6
7
8
9
10
11
12
Range("B38").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-36]C:R[-1]C)"
    Range("B38").Select
    Selection.AutoFill Destination:=Range("B38:P38"), Type:=xlFillDefault
    Range("B38:P38").Select
    ActiveWindow.SmallScroll Down:=-27
    Range("Q2").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-15]:RC[-1])"
    Range("Q2").Select
    Selection.AutoFill Destination:=Range("Q2:Q38"), Type:=xlFillDefault
    Range("Q2:Q38").Select
    Range("Q39").Select

Donc dans la case Q38, il y a le nombre total de points enregistrés. J'en profite mon mettre le tableau en pourcentage : je multiplie toutes les cellules de B2 à P37 par 100/q38
Jusque là c'est assez facile et mon programme marche. C'est peut être pas très rapide mais ça marche ! Là où ca se complqie, c'est pour créer sur chaque onglet, un histogramme des vitesses et un histogramme des directions à partir des totaux. Je voulais créer les deux histogrammes avant de passer à un autre onglet... J'ai tenté en modifiant le programme de l'enregistreur de macro mais ca n'a pas fonctionner (ca aurait été trop beau !)

Quelqu'un pourrait-il m'expliquer comment faire ?

merci beaucoup !

[mercatog]

Code :

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
107
108
109
110
Sub Creation()
Dim Mois As String, Annee As String, Pt As String
Dim Classeur As Workbook
Dim Chemin As String
 
Application.ScreenUpdating = False
With ThisWorkbook
    Chemin = .Path & "\"
    With .Worksheets("Feuil1")    'à adapter
        Mois = .Range("H13")                     'nom ou numéro du mois. Cette case est remplie par l'utilisateur qui lance la macro
        Annee = .Range("H14")                    'année Cette case est remplie par l'utilisateur qui lance la macro
        Pt = .Range("H15")                       'A ou B suivant le point de mesure Cette case est remplie par l'utilisateur qui lance la macro
    End With
End With
Set Classeur = Application.Workbooks.Add(1)
Preparation Classeur
Application.DisplayAlerts = False
With Classeur
    .Sheets(.Sheets.Count).Delete
    .SaveAs Filename:=Chemin & "corr_pt" & Pt & "_" & Mois & "_" & Annee, FileFormat:=xlNormal
    .Close
    Application.DisplayAlerts = True
End With
Set Classeur = Nothing
End Sub
 
Private Sub Preparation(Wbk As Workbook)
Dim Sh As Worksheet
Dim i As Byte
 
Application.ScreenUpdating = False
With Wbk
    For i = 1 To 10
        Set Sh = .Worksheets.Add(Before:=.Sheets(.Sheets.Count))
        With Sh
            .Name = "c " & i                     'nouvel onglet... Il est prévu d'en créer 9
            With .Range("A2:A37")
                .Formula = "=10*(ROW()-2)&""° - ""&10*(ROW()-1)&""°"""
                .Value = .Value
            End With
            With .Range("B1:P1")
                .Formula = "="" < "" & (Column() - 1) / 10 & "" m/s"""
                .Value = .Value
            End With
        End With
        Remplissage Sh, i
        Histo Sh, Sh.Range("B1:P1"), Sh.Range("B38:P38"), 0, "Histogramme des vitesses"
        Histo Sh, Sh.Range("A2:A37"), Sh.Range("Q2:Q37"), 500, "Histogramme des directions"
        Set Sh = Nothing
    Next i
End With
End Sub
 
Sub Remplissage(Ws As Worksheet, Col As Byte)
Dim V As Double, Dirp As Double
Dim DerLig As Long, i As Long
Dim j As Integer, k As Byte
Dim Tb, Res
 
Application.ScreenUpdating = False
With Ws
    Res = .Range("B2:P37")
    With ThisWorkbook.Worksheets(2)
        DerLig = .Cells(.Rows.Count, Col).End(xlUp).Row
        If DerLig > 1 Then
            Tb = .Range(.Cells(2, 2 * Col), .Cells(DerLig, 2 * Col + 1))
            For i = 1 To DerLig - 1
                V = Val(Tb(i, 1))
                Dirp = Val(Tb(i, 2))
                j = Int(10 * V + 1)
                If j > 15 Then j = 15
                k = Int(Abs(Dirp / 10 - 0.1)) + 1
                If k > 36 Then k = 36
                Res(k, j) = Val(Res(k, j)) + 100 / (DerLig - 1)
            Next i
        End If
    End With
    .Range("B2:P37") = Res
 
    '==Lignes suivantes pour les totaux
    With .Range("B38:P38")
        .Formula = "=SUM(B2:B37)"
        .Value = .Value
    End With
    With .Range("Q2:Q38")
        .Formula = "=SUM(B2:P2)"
        .Value = .Value
    End With
    .Range("Q1") = "Total"
    .Range("A38") = "Total"
End With
End Sub
 
Private Sub Histo(Sh As Worksheet, ByVal RngX As Range, ByVal RngY As Range, ByVal Lft As Long, ByVal Tit As String)
Dim Ch As ChartObject
 
Application.ScreenUpdating = False
Set Ch = Sh.ChartObjects.Add(Lft, Sh.Range("A40").Top, 500, 300)
With Ch.Chart
    .ChartType = xlColumnClustered
    .HasLegend = False
    .HasTitle = True
    .ChartTitle.Caption = Tit
    With .SeriesCollection.NewSeries
        .XValues = RngX
        .Values = RngY
    End With
End With
Set Ch = Nothing
End Sub

[Titened]

Merci beaucoup pour l'amélioration de mon programme !! Il marche super vite, c'est génial !!
par contre il y a un petit hic dans le programme remplissage. Il ne rempli pas correctement les tableaux. Est-ce que tu pourrais m'expliquer le morceau du code ci dessous, stp ? c'est une partie que je ne comprend pas très bien dans le code.

Code :

1
2
3
4
5
j = Int(10 * V + 1)
                If j > 15 Then j = 15
                k = Int(Abs(Dirp / 10 - 0.1)) + 1
                If k > 36 Then k = 36
                Res(k, j) = Val(Res(k, j)) + 100 / (DerLig - 1)

Merci beaucoup !!

[mercatog]

Effectivement, remplace cette partie du code par celle-ci

Code :

1
2
3
4
5
6
7
8
9
10
11
            For i = 1 To DerLig - 1
                V = Val(Tb(i, 1))
                j = Int(Abs(10 * V - 0.0005)) + 1
                If j > 15 Then j = 15
 
                Dirp = Val(Tb(i, 2))
                k = Int(Abs(Dirp - 0.0005) / 10) + 1
                If k > 36 Then k = 36
 
                Res(k, j) = Val(Res(k, j)) + 100 / (DerLig - 1)
            Next i

Les 2 lignes sont une re formulation de tes Select
Pour tester, exécute dans un nouveau fichier les deux codes Test1 et Test2 ci-après

Code :

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
'Ton code
Function f1(ByVal V As Double) As Byte
Dim j As Byte
 
Select Case V
    Case 0 To 0.1: j = 1
    Case 0.1001 To 0.2: j = 2
    Case 0.2001 To 0.3: j = 3
    Case 0.3001 To 0.4: j = 4
    Case 0.4001 To 0.5: j = 5
    Case 0.5001 To 0.6: j = 6
    Case 0.6001 To 0.7: j = 7
    Case 0.7001 To 0.8: j = 8
    Case 0.8001 To 0.9: j = 9
    Case 0.9001 To 1: j = 10
    Case 1.0001 To 1.1: j = 11
    Case 1.1001 To 1.2: j = 12
    Case 1.2001 To 1.3: j = 13
    Case 1.3001 To 1.4: j = 14
    Case 1.4001 To 1.5: j = 15
End Select
f1 = j
End Function
 
'Le mien
Function f2(ByVal V As Double) As Byte
Dim j As Integer
 
j = Int(Abs(10 * V - 0.0005)) + 1
If j > 15 Then j = 15
f2 = j
End Function
 
Sub Test1()
Dim j As Integer
 
With Worksheets("Feuil3")
    For j = 0 To 1510
        .Cells(j + 1, 1) = j / 1000
        .Cells(j + 1, 2) = f1(j / 1000)
        .Cells(j + 1, 3) = f2(j / 1000)
    Next j
End With
End Sub

Code :

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
'Ton code
Function g1(ByVal Dirp As Double) As Byte
Dim k As Byte
 
Select Case Dirp
    Case 0 To 10: k = 1
    Case 10.001 To 20: k = 2
    Case 20.001 To 30: k = 3
    Case 30.001 To 40: k = 4
    Case 40.001 To 50: k = 5
    Case 50.001 To 60: k = 6
    Case 60.001 To 70: k = 7
    Case 70.001 To 80: k = 8
    Case 80.001 To 90: k = 9
    Case 90.001 To 100: k = 10
    Case 100.001 To 110: k = 11
    Case 110.001 To 120: k = 12
    Case 120.001 To 130: k = 13
    Case 130.001 To 140: k = 14
    Case 140.001 To 150: k = 15
    Case 150.001 To 160: k = 16
    Case 160.001 To 170: k = 17
    Case 170.001 To 180: k = 18
    Case 180.001 To 190: k = 19
    Case 190.001 To 200: k = 20
    Case 200.001 To 210: k = 21
    Case 210.001 To 220: k = 22
    Case 220.001 To 230: k = 23
    Case 230.001 To 240: k = 24
    Case 240.001 To 250: k = 25
    Case 250.001 To 260: k = 26
    Case 260.001 To 270: k = 27
    Case 270.001 To 280: k = 28
    Case 280.001 To 290: k = 29
    Case 290.001 To 300: k = 30
    Case 300.001 To 310: k = 31
    Case 310.001 To 320: k = 32
    Case 320.001 To 330: k = 33
    Case 330.001 To 340: k = 34
    Case 340.001 To 350: k = 35
    Case 350.001 To 360: k = 36
End Select
 
g1 = k
End Function
 
'Le mien
Function g2(ByVal Dirp As Double) As Byte
Dim k As Integer
 
k = Int(Abs(Dirp - 0.0005) / 10) + 1
If k > 36 Then k = 36
g2 = k
End Function
 
Sub Test2()
Dim j As Integer
 
With Worksheets("Feuil2")
    For j = 0 To 2510
        .Cells(j + 1, 1) = j / 100
        .Cells(j + 1, 2) = g1(j / 100)
        .Cells(j + 1, 3) = g2(j / 100)
    Next j
End With
End Sub

[Titened]

Ok, avec la modif, je comprend mieux ! J'ai fait les deux tests et ton code marche mieux que le mien pour les valeur supérieur à 1,5 pour la vitesse merci

mais j'ai toujours le problème du remplissage qui ne fonctionne pas correctement quand je le lance. J'ai tenté de chercher l'erreur par moi-même, en vain... j'ai joint le fichier le point, si ca ne te genes pas, est ce que tu peux regarder ce qui ne va pas ?

Merci d'avoir passé autant de temps à résoudre mon problème et désolée de t'en demander un peu plus..

PJ : oct2011.rar

[mercatog]

mais j'ai toujours le problème du remplissage qui ne fonctionne pas correctement quand je le lance

A quel niveau?


EDIT

J'ai revérifié à l'aide d'un TCD avec groupement. Dans le code il fallait prendre les intervalles [0, 0.1[ [0.1, 0.2[ ....etc

Le code précédent tenait compte de [0, 0.1] ]0.1, 0.2]...etc

De même pour les directions

Avec ce changement sur les variables j et k, tu auras les mêmes données qu'un TCD avec groupement.

Code :

1
2
3
4
5
6
7
8
9
10
11
            For i = 1 To DerLig - 1
                V = Val(Tb(i, 1))
                j = Int(10 * V) + 1              'j = Int(Abs(10 * V - 0.0005)) + 1
                If j > 15 Then j = 15
                Dirp = Val(Tb(i, 2))
 
                k = Int(Dirp / 10) + 1           'k = Int(Abs(Dirp - 0.0005) / 10) + 1
                If k > 36 Then k = 36
 
                Res(k, j) = Val(Res(k, j)) + 100 / (DerLig - 1)
            Next i

[Titened]

Je suis d'accord avec toi !! Normalement ça devrait marcher !!!

mais il ne rempli que la colonne [0 0,1[ et c'est ce que je ne comprend pas. Je sais que mes valeurs varient entre 0 et 1,2 pour les vitesses. J'ai vérifié qu'il y avait bien des virgules et non des points dans le classeur "courant", feuille (2). J'ai aussi vérifier l'emplacement des colones vitesses et directions par rapport au programme.

De plus il affiche la même valeur 1,011712345 et la somme totale de toutes les valeur ne fait pas 100... du coup j'ai tenté de remettre les selects sur V et dirp dans ton programme et j'obtiens le même résultat...

Je ne sais plus où chercher !

encore merci pour ton aide ! C'est super sympa !

[mercatog]

Sur ton fichier .csv j'avais remplacé les données vers .xls en modifiant les virgules en points (mon séparateur décimal est le point)
Le code fonctionne chez moi!

Si tu fais un tableau croisé dynamique en faisant un groupement, qu'obtiens-tu?

[Titened]

en remplacant les virgules par des points, il réparti bien une valeur en fonction de la vitesse et de la direction. Sauf qu'il met toujours la même valeur 1,011712345 au lieu de compter le nombre de fois où on obtient une vitesse et une direction données. Cette valeur correspond à 100/(DerLig-1).


je ne sais pas ce qu'est un tableau dynamique ni un groupement

milles merci pour toute l'aide que tu m'apportes !

[mercatog]

Tes chiffres ne sont pas considérés comme des nombres parce que la somme ne se fait pas.

Le point ou la virgule dépend du séparateur décimal de ton poste de travail.

Attends, ton fichier est un csv. L'as tu converti en fichier excel (.xls) avec pour chaque colonne les données correspondantes

[Titened]

J'ai peut être trouvé l'erreur...

Mon séparateur de décimal est un point pour le code mais dans excel c'est une virgule. Du coup il trie bien en fonction des vitesses et des direction mais il n'arrive pas a les compter car il y a une virgule à la place d'un point. Il ne comprend donc pas que c'est un nombre !!!

est-ce que je peux encore profiter de ta gentillesse pour savoir comment mettre un point pour séparateur de décimal dans excel ?

merci beaucoup d'avance !

et ben non ce n'est pas ça. J'ai trouvé comment changer le séparateur de décimaux
(pour ceux que ça intéresse : bouton office -> options exel -> options avancés, décocher "utiliser les séparateurs du système")

et il ne compte toujours pas.

Donc c'est val(res(k,j)) dans l'équation
res(k,j)= val(res(k,j)) + 100/(DerLig-1) qui plante....

Merci beaucoup de me consacrer autant de temps !

[mercatog]

Envoyé par mercatog

Attends, ton fichier est un csv. L'as tu converti en fichier excel (.xls) avec pour chaque colonne les données correspondantes

Sinon, mets en PJ ton fichier.

[Titened]

J'avais oublié de préciser : j'avais spécialement créer un fichier excel. J'ai rempli les vitesses et les directions de manière aléatoire pour voir si justement j'avais le problème de conversion de fichier, suite à ton message.

je te joins le fichier de points converti en excel.

PJ : nov_2011.xlsx

OK !!!!

lorsque je met

res(k,j) = val(res(k,j) + 1

à la place de

res(k,j) = val(res(k,j) + 100/(DerLig - 1)

ca marche, j'ai le bon nombre de point total, et le tableau se rempli correctement !!!! (sauf que du coup je n'ai plus de pourcentage)

Je vois enfin le bout de ce programme !! Merci beaucoup pour toute l'aide que tu m'as apportée !!

[mercatog]

Ton fichier que tu as mis en PJ est t il l'identique de ton fichier original?
Tu as la feuille des donnée en 2ème position et en 1ère position tu as la feuille d'où sortir le nom du fichier H13, H14 et H15.

Si c'est ça, je viens de tester sans problème

Code :

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
107
108
109
110
111
112
113
114
Option Explicit
 
Sub Creation()
Dim Mois As String, Annee As String, Pt As String
Dim Classeur As Workbook
Dim Chemin As String
 
Application.ScreenUpdating = False
With ThisWorkbook
    Chemin = .Path & "\"
    With .Worksheets("Feuil1")    'à adapter
        Mois = .Range("H13")                     'nom ou numéro du mois. Cette case est remplie par l'utilisateur qui lance la macro
        Annee = .Range("H14")                    'année Cette case est remplie par l'utilisateur qui lance la macro
        Pt = .Range("H15")                       'A ou B suivant le point de mesure Cette case est remplie par l'utilisateur qui lance la macro
    End With
End With
Set Classeur = Application.Workbooks.Add(1)
Preparation Classeur
Application.DisplayAlerts = False
With Classeur
    .Sheets(.Sheets.Count).Delete
    .SaveAs Filename:=Chemin & "corr_pt" & Pt & "_" & Mois & "_" & Annee, FileFormat:=xlNormal
    .Close
    Application.DisplayAlerts = True
End With
Set Classeur = Nothing
End Sub
 
Private Sub Preparation(Wbk As Workbook)
Dim Sh As Worksheet
Dim i As Byte
 
Application.ScreenUpdating = False
With Wbk
    For i = 1 To 10
        Set Sh = .Worksheets.Add(Before:=.Sheets(.Sheets.Count))
        With Sh
            .Name = "c " & i                     'nouvel onglet... Il est prévu d'en créer 9
            With .Range("A2:A37")
                .Formula = "=10*(ROW()-2)&""° - ""&10*(ROW()-1)&""°"""
                .Value = .Value
            End With
            With .Range("B1:P1")
                .Formula = "="" < "" & (Column() - 1) / 10 & "" m/s"""
                .Value = .Value
            End With
        End With
        Remplissage Sh, i
        Histo Sh, Sh.Range("B1:P1"), Sh.Range("B38:P38"), 0, "Histogramme des vitesses"
        Histo Sh, Sh.Range("A2:A37"), Sh.Range("Q2:Q37"), 500, "Histogramme des directions"
        Set Sh = Nothing
    Next i
End With
End Sub
 
Sub Remplissage(Ws As Worksheet, Col As Byte)
Dim V As Double, Dirp As Double
Dim DerLig As Long, i As Long
Dim j As Integer, k As Byte
Dim Tb, Res
 
Application.ScreenUpdating = False
With Ws
    Res = .Range("B2:P37")
    With ThisWorkbook.Worksheets(1) 'ICI L'INDEX DE LA FEUILLE DES DONNEES. POUR CE FICHIER C'EST LA FEUILLE 1
        DerLig = .Cells(.Rows.Count, 2 * Col).End(xlUp).Row
        If DerLig > 1 Then
            Tb = .Range(.Cells(2, 2 * Col), .Cells(DerLig, 2 * Col + 1))
            For i = 1 To DerLig - 1
                V = Val(Replace(Tb(i, 1), ",", "."))
                j = Int(10 * V) + 1
                If j > 15 Then j = 15
                Dirp = Val(Replace(Tb(i, 2), ",", "."))
 
                k = Int(Dirp / 10) + 1           'k = Int(Abs(Dirp - 0.0005) / 10) + 1
                If k > 36 Then k = 36
 
                Res(k, j) = Res(k, j) + 100 / (DerLig - 1)
            Next i
        End If
    End With
    .Range("B2:P37") = Res
 
    '==Lignes suivantes pour les totaux
    With .Range("B38:P38")
        .Formula = "=SUM(B2:B37)"
        .Value = .Value
    End With
    With .Range("Q2:Q38")
        .Formula = "=SUM(B2:P2)"
        .Value = .Value
    End With
    .Range("Q1") = "Total"
    .Range("A38") = "Total"
End With
End Sub
 
Private Sub Histo(Sh As Worksheet, ByVal RngX As Range, ByVal RngY As Range, ByVal Lft As Long, ByVal Tit As String)
Dim Ch As ChartObject
 
Application.ScreenUpdating = False
Set Ch = Sh.ChartObjects.Add(Lft, Sh.Range("A40").Top, 500, 300)
With Ch.Chart
    .ChartType = xlColumnClustered
    .HasLegend = False
    .HasTitle = True
    .ChartTitle.Caption = Tit
    With .SeriesCollection.NewSeries
        .XValues = RngX
        .Values = RngY
    End With
End With
Set Ch = Nothing
End Sub

Adapte le nom de la feuille en ligne 11 et l'index de la feuille de données en ligne 65 et la ligne 66 corrigée (mais sans interférence)

Edit: Lignes 70, 72 et 78 modifiés pour prendre en compte l'éventualité si le séparateur décimal est la virgule

[Titened]

En tant que blonde confirmée, je t'avais joint le mauvais fichier !

grace aux lignes 70, 72 et 78 qui considère le point et la virgule comme séparateur de décimaux ton code marche impécable !!! il est rapide et affiche tous les histogrammes comme il faut, nikel !

merci pour tout !!!!