Créer macro et modifier
Bonjour,
Je travaille actuellement sur un lourd fichier et pour chaque pays je dois calculer la moyenne, les quartiles, le min max et le mode.
Je le fais mais le problème c'est que je suis obligée de le faire pour chaque pays et cela me prend un temps fou.
J'aimerais donc programmer une macro pour que cela me le fasse pour chaque pays (j'ai tous les pays du monde....).
Si vous pouviez m'aider ou autres solutions merci de m'en faire part.
Bonjour Statistique64 le forum
oui pas de soucis pour t'aider, mais sans fichier ???
a+
Papou
merci de votre réponse, j'ai copié un mini fichier pour vous montrer le type, le vrai est beaucoup trop lourd
Bonjour,
Peux-tu préciser la version Excel que tu utilises ? Excel 2018 n'existe pas.
Et nous dire si tu travailles sous PC ou Mac.
Modifie ton profil en conséquence.
Envoi un fichier plus conséquent, en sachant que sa taille ne doit pas être supérieure à 1Mo.
Cdlt.
Salut Stat64,
Salut l'équipe,
disons-le tout de suite : la médaille Fields ne sera jamais à moi!
Quartile, mode... du chinois pour moi! D'ailleurs, ici, MODE n'est pas calculé!
L'essentiel, c'est la méthode que j'utilise en espérant, quand même, que les calculs se basent bien sur la colonne [H]!
(Tu vois à quel stade d'ignorance je suis!)
Aux matheux à corriger les formules!
Un double-clic démarre la macro...
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tData, tExtract
'
Cancel = True
'
tData = Range("E1:H" & Range("E" & Rows.Count).End(xlUp).Row + 1).Value
Range("I2:O" & Range("E" & Rows.Count).End(xlUp).Row).ClearContents
tExtract = Range("I1:O" & Range("E" & Rows.Count).End(xlUp).Row + 1).Value
'
For x = 2 To UBound(tData, 1)
If tData(x, 1) <> tData(x - 1, 1) Then
If lStart > 0 Then
tExtract(lStart, 1) = lTotal / (x - lStart)
tExtract(lStart, 2) = "=QUARTILE(H" & lStart & ":H" & x - 1 & ";4)"
tExtract(lStart, 3) = "=QUARTILE(H" & lStart & ":H" & x - 1 & ";0)"
'tExtract(lStart, 4) = "=QUARTILE(H" & lStart & ":H" & x - 1 & ";4)"
tExtract(lStart, 5) = "=QUARTILE(H" & lStart & ":H" & x - 1 & ";1)"
tExtract(lStart, 6) = "=QUARTILE(H" & lStart & ":H" & x - 1 & ";2)"
tExtract(lStart, 7) = "=QUARTILE(H" & lStart & ":H" & x - 1 & ";3)"
lTotal = 0
End If
lStart = x
End If
lTotal = lTotal + tData(x, 4)
Next
Range("I1:O" & UBound(tExtract, 1)).FormulaLocal = tExtract
'
End SubA+
Bonjour,
Peux-tu préciser la version Excel que tu utilises ? Excel 2018 n'existe pas.
Et nous dire si tu travailles sous PC ou Mac.
Modifie ton profil en conséquence.
Envoi un fichier plus conséquent, en sachant que sa taille ne doit pas être supérieure à 1Mo.
Cdlt.
Alors je suis sous Windows et j'utilise la dernière version d'Excel.
Voici le fichier dans sa globalité, vous pouvez voir que je suis obligée de tout calculer fonction par fonction, pays par pays et cela me prend un temps enorme car j'ai plusieurs fichiers comme cela. mon but final est de créer des boîtes à moustaches pour chaque pays pour calculer le délai moyen d'obtention d'un certificat pour chaque pays.
Salut Stat64,
Salut l'équipe,
disons-le tout de suite : la médaille Fields ne sera jamais à moi!
Quartile, mode... du chinois pour moi! D'ailleurs, ici, MODE n'est pas calculé!
L'essentiel, c'est la méthode que j'utilise en espérant, quand même, que les calculs se basent bien sur la colonne [H]!
(Tu vois à quel stade d'ignorance je suis!)
Aux matheux à corriger les formules!
Un double-clic démarre la macro...
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) ' Dim tData, tExtract ' Cancel = True ' tData = Range("E1:H" & Range("E" & Rows.Count).End(xlUp).Row + 1).Value Range("I2:O" & Range("E" & Rows.Count).End(xlUp).Row).ClearContents tExtract = Range("I1:O" & Range("E" & Rows.Count).End(xlUp).Row + 1).Value ' For x = 2 To UBound(tData, 1) If tData(x, 1) <> tData(x - 1, 1) Then If lStart > 0 Then tExtract(lStart, 1) = lTotal / (x - lStart) tExtract(lStart, 2) = "=QUARTILE(H" & lStart & ":H" & x - 1 & ";4)" tExtract(lStart, 3) = "=QUARTILE(H" & lStart & ":H" & x - 1 & ";0)" 'tExtract(lStart, 4) = "=QUARTILE(H" & lStart & ":H" & x - 1 & ";4)" tExtract(lStart, 5) = "=QUARTILE(H" & lStart & ":H" & x - 1 & ";1)" tExtract(lStart, 6) = "=QUARTILE(H" & lStart & ":H" & x - 1 & ";2)" tExtract(lStart, 7) = "=QUARTILE(H" & lStart & ":H" & x - 1 & ";3)" lTotal = 0 End If lStart = x End If lTotal = lTotal + tData(x, 4) Next Range("I1:O" & UBound(tExtract, 1)).FormulaLocal = tExtract ' End SubA+
Bonjour,
Alors j'ai l'habitude de coder sur des logiciels de statistiques mais je ne sais pas coder sur Excel
En te remerciant,
Salut Stat64,
désolé pour le retard : c'est rare mais je suis passé à côté de tes réponses!
J'ai complété la macro (c'était vraiment tout c...!) : les résultats sont identiques à ceux affichés dans ton fichier.
Un simple double-clic n'importe où démarre la macro!
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tData, tExtract
'
Cancel = True
'
tData = Range("E1:H" & Range("E" & Rows.Count).End(xlUp).Row + 1).Value
Range("I2:Q" & Range("E" & Rows.Count).End(xlUp).Row).ClearContents
tExtract = Range("I1:Q" & Range("E" & Rows.Count).End(xlUp).Row + 1).Value
'
For x = 2 To UBound(tData, 1)
If tData(x, 1) <> tData(x - 1, 1) Then
If lStart > 0 Then
tExtract(lStart, 1) = lTotal / (x - lStart)
tExtract(lStart, 2) = "=QUARTILE(H" & lStart & ":H" & x - 1 & ";4)"
tExtract(lStart, 3) = "=QUARTILE(H" & lStart & ":H" & x - 1 & ";0)"
tExtract(lStart, 4) = "=MEDIANE(H" & lStart & ":H" & x - 1 & ")"
tExtract(lStart, 5) = "=MODE(H" & lStart & ":H" & x - 1 & ")"
tExtract(lStart, 6) = "=QUARTILE(H" & lStart & ":H" & x - 1 & ";1)"
tExtract(lStart, 7) = "=QUARTILE(H" & lStart & ":H" & x - 1 & ";2)"
tExtract(lStart, 8) = "=QUARTILE(H" & lStart & ":H" & x - 1 & ";3)"
lTotal = 0
End If
lStart = x
End If
lTotal = lTotal + tData(x, 4)
Next
Range("I1:Q" & UBound(tExtract, 1)).FormulaLocal = tExtract
'
End SubBon, voilà que Windows refuse de charger un fichier, maintenant... :
Le code doit être collé dans le module VBA de la feuille à traiter.
A+
Bonjour statistiques64, curulis57,
[quote="dans ton post du 17 août à 08:14, tu"]Ton code je dois le mettre où en fait ?[/quote]
[quote="dans son post du 19 août à 02:45, curulis"]Le code doit être collé dans le module VBA de la feuille à traiter.[/quote]
1) j'ai converti le fichier "test_recepisse_marque - Copie.xlsx" en "test récépissé marque.xlsm" (pour pouvoir y mettre du code VBA)
2) j'ai mis le code VBA de curulis57 dans le module de la 1ère feuille "test_recepisse_marque" (j'espère que j'me suis pas trompé)
3) j'ai un peu modifié le code VBA de curulis57 :
* j'ai légèrement modifié l'indentation
* j'ai ajouté Option Explicit
* j'ai complété la ligne Dim : ajout de , x&, lstart&, ltotal#
* j'ai complété le Next : Next x
voici le fichier :
⚠ comme j'avais pas envie de faire des stats,
j'ai pas testé le code VBA ; à toi d'essayer !
si y'a kek'chose qui va pas, vois la suite avec curulis57
dhany
Salut Stat64,
l'intervention de Dhany m'a permis de constater un souci si les lignes supérieures sont cachées.
Les lignes du fichier que j'utilise sont toutes affichées et dans ce cas, pas de problème!
Si tu veux pouvoir travailler avec des lignes cachées, il faudra me le dire que je puisse modifier le code en fonction.
@Dhany : intention louable qui a eu le mérite de révéler le souci décrit plus haut.
Seule petite chose : je n'apprécie guère le changement d'indentation! Commence par soigner la tienne avant de donner l'impression de faire la leçon aux autres!!
A+
@curulis57
tu a écrit :@Dhany : intention louable qui a eu le mérite de révéler le souci décrit plus haut.
ça, ça m'a fait bien plaisir !
tu a écrit :Seule petite chose : je n'apprécie guère le changement d'indentation! Commence par soigner la tienne avant de donner l'impression de faire la leçon aux autres!!
par contre ça, beaucoup moins ! j'ai indenté à ma façon, et c'est la mienne (si elle ne te plaît pas, c'est autre chose) ; et t'avais pas à l'prendre mal, car en aucun cas, j'ai voulu « donner l'impression de faire la leçon aux autres » !
pour ton info personnelle, j'ai appris la programmation structurée avec le très bon langage structuré qu'est Turbo Pascal (dont le langage Delphi est un dérivé actuel) ; alors j'peux t'dire que j'sais bien comment indenter mes programmes ; ton « Commence par soigner la tienne » est vraiment inapproprié ! c'est vraiment sympa de ta part d'me remercier ainsi d'avoir aidé statistiques64 alors qu'il savait pas comment faire et qu'tu lui as simplement répondu : « Le code doit être collé dans le module VBA de la feuille à traiter. » (sans même préciser laquelle exactement !) ; c'est sympa, vraiment sympa !
j'te signale que j'ai seulement écrit : « j'ai légèrement modifié l'indentation » ; alors j'vois pas c'qui a d'blessant là-dedans !
si j'l'ai écrit, c'est absolument pas pour te vexer, mais pour que tu aies la liste de toutes les modifs que j'ai faites.
puisque tu l'as pris comme ça, j'vais te dire c'que j'aime pas du tout dans ton indentation : c'est tes lignes qui sont tout contre la marge gauche, donc au même niveau que Private Sub... et End Sub ! normalement, il devrait y avoir rien d'autre que les étiquettes de branchement (labels) ; avec une « tolérance » pour les lignes Dim (bien qu'elles aussi devraient être en retrait).
si tu te demandes pourquoi j'ai réduit la tabulation d'indentation de 4 espaces à 2 seulement, c'est pa'c'que c'est mon habitude pour éviter que les lignes soient trop loin à droite, et pour moi, cette indentation de 2 espaces seulement est suffisante pour bien voir toute la logique du code.
puisque tu t'es pas gêné pour me critiquer, à mon tour de te faire une critique sévère : je comprends pas que tu aies pas mis « Option Explicit » ; si tu l'avais fait, tu te serais rendu compte que 3 de tes variables n'étaient pas déclarées, et non typées non plus !
il s'agit de : x&, lstart&, ltotal# ; et il m'a bien sûr fallu lire attentivement ton code VBA pour déterminer quel était le type le plus approprié ; alors merci pour tes chaleureux remerciements et ta critique si judicieuse de ma propre indentation ! vraiment sympa !
j'dis pas qu'ma façon d'indenter est la meilleure, mais elle a au moins le mérite de respecter les conventions usuelles de la programmation structurée, et je déclare toutes mes variables, moi ! c'qui est un impératif absolu avec « Option Explicit ».
autre critique : mettre un Next sans la variable associée ! t'es suffisamment bon pour savoir que ça accélère le code puisque VBA n'a pas à chercher quelle est la variable à incrémenter, pas vrai ? alors j'préfère penser qu'c'était juste un oubli !
cela dit, tu es un très bon programmeur, et tu fais souvent des codes VBA que j'arriverais pas à faire !
dhany
bonjour à tous
pour une analyse par pays (ou par n'importe quoi d'autre), depuis 8 mois je conseille Power BI desktop gratuit
puissant, interactif, beau à en pleurer, avec des cartes du monde (zoomables ! ) affichant les valeurs.
pas de macro, mais parfois des formules (langage de formules DAX), que je conseille de chercher sur le net de de recopier (car DAX est... pas facile)
https://www.dash-intel.com/powerbi/statistical_functions_percentile.php
les données peuvent venir d'Excel ou de tas d'autres sources (je ne sais même pas bien ce que sont 90% de ces sources ! )
Salut Stat,
Salut l'équipe,
je n'avais pas (encore!) fait attention à la deuxième feuille!
Je l'ai renommée 'GRAPH', y affiche le résumé des résultats par pays et y ai ajouté une MFC pour souligner les valeurs "inférieure" en [E].
Toujours un double-clic pour démarrer la macro en feuille 'Test...'.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tData, tExtract, tData1(), tData2()
Dim iIdx%
'
Cancel = True
Application.ScreenUpdating = False
'
tData = Range("E1:H" & Range("E" & Rows.Count).End(xlUp).Row + 1).Value
Range("I2:P" & Range("E" & Rows.Count).End(xlUp).Row).ClearContents
tExtract = Range("I1:P" & Range("E" & Rows.Count).End(xlUp).Row + 1).Value
'
For x = 2 To UBound(tData, 1)
If tData(x, 1) <> tData(x - 1, 1) Then
If lStart > 0 Then
iIdx = iIdx + 1
tExtract(lStart, 1) = lTotal / (x - lStart)
tExtract(lStart, 2) = "=QUARTILE(H" & lStart & ":H" & x - 1 & ";4)"
tExtract(lStart, 3) = "=QUARTILE(H" & lStart & ":H" & x - 1 & ";0)"
tExtract(lStart, 4) = "=MEDIANE(H" & lStart & ":H" & x - 1 & ")"
tExtract(lStart, 5) = IIf(x - lStart = 1, "=" & tData(x - 1, 4), "=MODE(H" & lStart & ":H" & x - 1 & ")")
tExtract(lStart, 6) = "=QUARTILE(H" & lStart & ":H" & x - 1 & ";1)"
tExtract(lStart, 7) = "=QUARTILE(H" & lStart & ":H" & x - 1 & ";2)"
tExtract(lStart, 8) = "=QUARTILE(H" & lStart & ":H" & x - 1 & ";3)"
lTotal = 0
End If
lStart = x
End If
lTotal = lTotal + tData(x, 4)
Next
Range("I1:P" & UBound(tExtract, 1)).FormulaLocal = tExtract
tData = Range("E2:P" & Range("I" & Rows.Count).End(xlUp).Row).Value
'
ReDim tData1(iIdx, 4)
ReDim tData2(iIdx, 4)
iIdx = 0
For x = 1 To UBound(tData, 1)
If tData(x, 5) <> "" Then
iIdx = iIdx + 1
For y = 1 To 4
tData1(iIdx - 1, y - 1) = IIf(y = 1, tData(x, 1), tData(x, y + 4))
tData2(iIdx - 1, y - 1) = tData(x, y + 8)
Next
End If
Next
With Worksheets("GRAPH")
.Range("A3").Resize(iIdx, 4).ClearContents
.Range("F3").Resize(iIdx, 4).ClearContents
.Range("A3").Resize(iIdx, 4) = tData1
.Range("F3").Resize(iIdx, 4) = tData2
.Activate
End With
Application.ScreenUpdating = True
'
End SubCurieux de connaître le bilan d'un test grandeur nature...
A+
Salut Stat64,
l'intervention de Dhany m'a permis de constater un souci si les lignes supérieures sont cachées.
Les lignes du fichier que j'utilise sont toutes affichées et dans ce cas, pas de problème!
Si tu veux pouvoir travailler avec des lignes cachées, il faudra me le dire que je puisse modifier le code en fonction.
@Dhany : intention louable qui a eu le mérite de révéler le souci décrit plus haut.
Seule petite chose : je n'apprécie guère le changement d'indentation! Commence par soigner la tienne avant de donner l'impression de faire la leçon aux autres!!
A+
Bonjour,
Merci à tous pour vos réponses, j'ai ouvert vos fichiers et essayé de copier coller le code, mais cela me met erreur à la ligne 9 ou déboggage
Salut Stat,
télécharge le fichier joint, au moins...
A+
Bonjour à tous,
Pas de retour sur ma proposition !...
Retour positif ou négatif ?
Cdlt.
Salut Stat,
Salut l'équipe,
je n'avais pas (encore!) fait attention à la deuxième feuille!
Je l'ai renommée 'GRAPH', y affiche le résumé des résultats par pays et y ai ajouté une MFC pour souligner les valeurs "inférieure" en [E].
Toujours un double-clic pour démarrer la macro en feuille 'Test...'.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) ' Dim tData, tExtract, tData1(), tData2() Dim iIdx% ' Cancel = True Application.ScreenUpdating = False ' tData = Range("E1:H" & Range("E" & Rows.Count).End(xlUp).Row + 1).Value Range("I2:P" & Range("E" & Rows.Count).End(xlUp).Row).ClearContents tExtract = Range("I1:P" & Range("E" & Rows.Count).End(xlUp).Row + 1).Value ' For x = 2 To UBound(tData, 1) If tData(x, 1) <> tData(x - 1, 1) Then If lStart > 0 Then iIdx = iIdx + 1 tExtract(lStart, 1) = lTotal / (x - lStart) tExtract(lStart, 2) = "=QUARTILE(H" & lStart & ":H" & x - 1 & ";4)" tExtract(lStart, 3) = "=QUARTILE(H" & lStart & ":H" & x - 1 & ";0)" tExtract(lStart, 4) = "=MEDIANE(H" & lStart & ":H" & x - 1 & ")" tExtract(lStart, 5) = IIf(x - lStart = 1, "=" & tData(x - 1, 4), "=MODE(H" & lStart & ":H" & x - 1 & ")") tExtract(lStart, 6) = "=QUARTILE(H" & lStart & ":H" & x - 1 & ";1)" tExtract(lStart, 7) = "=QUARTILE(H" & lStart & ":H" & x - 1 & ";2)" tExtract(lStart, 8) = "=QUARTILE(H" & lStart & ":H" & x - 1 & ";3)" lTotal = 0 End If lStart = x End If lTotal = lTotal + tData(x, 4) Next Range("I1:P" & UBound(tExtract, 1)).FormulaLocal = tExtract tData = Range("E2:P" & Range("I" & Rows.Count).End(xlUp).Row).Value ' ReDim tData1(iIdx, 4) ReDim tData2(iIdx, 4) iIdx = 0 For x = 1 To UBound(tData, 1) If tData(x, 5) <> "" Then iIdx = iIdx + 1 For y = 1 To 4 tData1(iIdx - 1, y - 1) = IIf(y = 1, tData(x, 1), tData(x, y + 4)) tData2(iIdx - 1, y - 1) = tData(x, y + 8) Next End If Next With Worksheets("GRAPH") .Range("A3").Resize(iIdx, 4).ClearContents .Range("F3").Resize(iIdx, 4).ClearContents .Range("A3").Resize(iIdx, 4) = tData1 .Range("F3").Resize(iIdx, 4) = tData2 .Activate End With Application.ScreenUpdating = True ' End SubCurieux de connaître le bilan d'un test grandeur nature...
A+
je n'arrive pas non plus à l'exécuter même en essayant sur une feuille vide avec le code