• Initiateur de la discussion Initiateur de la discussion lolo_bob2
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

L

lolo_bob2

Guest
Bonjour

Voila j’ai un fichier excel et je voudrais réaliser une macro me permettant de regrouper des données (cf fichier joint « essai »).
Sur la colonne « J » j’ai des chiffres qui peuvent aller de 0 à 500.
Je voudrais lancer une macro qui me permette de compter le nombre de chiffres comme ceci

0 à 19 --> j’en ai 3
20 à 39--> j’en ai 4...

Par contre il faudrait que ça fonctionne avec plusieurs feuilles (ces feuilles n’ont pas toutes le même nom)

Merci de votre aide

@++
Lolo
 

Pièces jointes

Re : Classer des nombres

Bonjour Lolo_Bob2, le forum,

Voici une macro permettant de ventiler l'ensemble des valeurs de la colonne de ton choix dans chacune des feuilles.
J'ai ajouté un tableau de comptage pour chaque seuil
Tu trouveras en pièce jointe un fichier à adapter à tes besoins. Il te suffit de cliquer sur le bouton "Ventilation"

Code:
Dim T() As Variant

Sub VentilNombre()
Dim n&, r&, c&, i&, x&, f&, s&
f = ActiveWorkbook.Worksheets.Count
c = 10 'Colonne J
n = Cells(65536, c).End(3).Row 'Dernière cellule active de la colonne choisie

For s = 1 To f 'Pour chaque feuille
Sheets(s).Activate
    ReDim T(25, 2) 'Tableau virtuel pour comptage et ventilation
    For i = 0 To 25
        T(i, 0) = i * 20
        T(i, 1) = T(i, 0) + 19
    Next i
    
    'Ventilation des nombres
    For i = 2 To n
        x = Int(Cells(i, c) / 20)
        Select Case x
            Case Is < 1: T(x, 2) = T(x, 2) + 1
            Case Is < 2: T(x, 2) = T(x, 2) + 1
            Case Is < 3: T(x, 2) = T(x, 2) + 1
            Case Is < 4: T(x, 2) = T(x, 2) + 1
            Case Is < 5: T(x, 2) = T(x, 2) + 1
            Case Is < 6: T(x, 2) = T(x, 2) + 1
            Case Is < 7: T(x, 2) = T(x, 2) + 1
            Case Is < 8: T(x, 2) = T(x, 2) + 1
            Case Is < 9: T(x, 2) = T(x, 2) + 1
            Case Is < 10: T(x, 2) = T(x, 2) + 1
            Case Is < 11: T(x, 2) = T(x, 2) + 1
            Case Is < 12: T(x, 2) = T(x, 2) + 1
            Case Is < 13: T(x, 2) = T(x, 2) + 1
            Case Is < 14: T(x, 2) = T(x, 2) + 1
            Case Is < 15: T(x, 2) = T(x, 2) + 1
            Case Is < 16: T(x, 2) = T(x, 2) + 1
            Case Is < 17: T(x, 2) = T(x, 2) + 1
            Case Is < 18: T(x, 2) = T(x, 2) + 1
            Case Is < 19: T(x, 2) = T(x, 2) + 1
            Case Is < 20: T(x, 2) = T(x, 2) + 1
            Case Is < 21: T(x, 2) = T(x, 2) + 1
            Case Is < 22: T(x, 2) = T(x, 2) + 1
            Case Is < 23: T(x, 2) = T(x, 2) + 1
            Case Is < 24: T(x, 2) = T(x, 2) + 1
            Case Is < 25: T(x, 2) = T(x, 2) + 1
            Case Else: T(25, 2) = T(25, 2) + 1
        End Select
    Next i
    
    'Ecriture des résultats dans un tableau
    Cells(1, 3) = Ventilation
    Cells(2, 3) = "De"
    Cells(2, 4) = "A"
    Cells(2, 5) = "Nombre"
    For i = 0 To 24
        Cells(i + 3, 3) = T(i, 0)
        Cells(i + 3, 4) = T(i, 1)
        Cells(i + 3, 5) = T(i, 2)
    Next i
    Cells(28, 3) = T(25, 0)
    Cells(28, 4) = "et +"
    Cells(28, 5) = T(25, 2)
Next s
End Sub

En espérant avoir répondu à ta demande.

Bonne soirée

Kotov
 

Pièces jointes

Dernière édition:
Re : Classer des nombres

Bonsoir le fil, Kotov🙂

Si bien compris, tu peux remplacer tes select case par :
Code:
    'Ventilation des nombres
    For i = 2 To n
        x = Int(Cells(i, c) / 20)
        If x < 25 Then
            T(x, 2) = T(x, 2) + 1
        Else
            T(25, 2) = T(25, 2) + 1
        End If
    Next i

Cordialement
 
Re : Classer des nombres

Salut Spit 🙂;

Effectivement, c'est encore plus simple de cette manière.
J'avais commencé à faire cette ventilation "en dur" avec Select Case > 20, 40 etc.. avant de réaliser qu'on pouvait simplifier avec les multiples de 20.
Mais je n'ai pas poussé assez loin la simplification : le vendredi soir, les neurones tournent au ralenti.

Merci de ton apport. J'aime quand c'est épuré !

@ lolo : tu peux donc remplacer toute la partie comprise entre Select Case et End Select par la macro de Spit.

Bonne soirée
Kotov
 
Re : Classer des nombres

Merci kotov de ton aide

Par contre j'ai fais un essai avec mon fichier et je n'obtiens pas ce que je veux par exemple de 0 à 10 j'obtiens 18 nombre alors que j'en ai que 10 par exemple.
J'ai l'impression qu'il prend aussi les cellules vides.

Comment faire pour éviter cela sachant que le calcul se fait qu'a partir de la ligne 8 colonne J


Je vois aussi que ca fais le calcul par page est il possible d'avoir qu'un calcul final ? sur la dernière page si possible ?

ci joint le fichier

Merci beaucoup

Lolo
 

Pièces jointes

Re : Classer des nombres

Bonjour LoloBob_2, le forum,

La macro fonctionne parfaitement. Il était juste nécessaire de définir la rangée de départ (dans ton exemple la rangée 8). Pour adapter la macro à tes besoins, tu dois modifier le chiffre écrit en rouge.

Par ailleurs, j'ai intégré la simplification de Spit, ajouté à ton exemple un bouton de lancement, et modifié les valeurs de ta feuille 1 pour tester les échantillons.

Code:
Dim T() As Variant

Sub VentilNombre()
Dim n&, r&, c&, i&, x&, f&, s&
f = ActiveWorkbook.Worksheets.Count
c = 10 'Colonne J
n = Cells(65536, c).End(3).Row 'Dernière cellule active de la colonne choisie

For s = 1 To f 'Pour chaque feuille
Sheets(s).Activate
    ReDim T(25, 2) 'Tableau virtuel pour comptage et ventilation
    For i = 0 To 25
        T(i, 0) = i * 20
        T(i, 1) = T(i, 0) + 19
    Next i
    
    'Ventilation des nombres 
     For i =[b] [color=red]8[/color][/B] To n
        x = Int(Cells(i, c) / 20)
        If x < 25 Then
            T(x, 2) = T(x, 2) + 1
        Else
            T(25, 2) = T(25, 2) + 1
        End If
    Next i
   
    
    'Ecriture des résultats dans un tableau
    Cells(1, 19) = Ventilation
    Cells(2, 19) = "De"
    Cells(2, 20) = "A"
    Cells(2, 21) = "Nombre"
    For i = 0 To 24
        Cells(i + 3, 19) = T(i, 0)
        Cells(i + 3, 20) = T(i, 1)
        Cells(i + 3, 21) = T(i, 2)
    Next i
    Cells(28, 19) = T(25, 0)
    Cells(28, 20) = "et +"
    Cells(28, 21) = T(25, 2)
Next s
End Sub

En espérant répondre à ta demande.

Bonne journée
Kotov
 

Pièces jointes

Re : Classer des nombres

Bonjour Kotov

Merci beaucoup ca fonctionne parfaitement, par contre je voudrais avoir une feuille avec les résultats regroupant tous les classement (somme en fait)
ex 0-19 --> 8 feuille 1
0-19 -->2 feuille 2

Au total

0-19 --> 10 à la feuille total

Merci de ton aide ca me fais déjà gagner pas mal de temps
@++

Laurent
 
Re : Classer des nombres

Bonsoir Laurent,

Pas de problème pour une récap, mais pour me faire gagner du temps, peux-tu préparer ta feuille de synthèse ?
Ce soir, je suis en "zeitnot"

Je travaillerai sur ton fichier demain soir, si c'est urgent demandes aux collègues du forum de te filer un coup de main.

A +

Kotov
 
Re : Classer des nombres

Bonjour Lolo,

Est-ce bien la version définitive de ton fichier ?
Je viens de passer du temps sur la récap de tes données pour m'apercevoir en contrôlant les résultats que tu as modifié les intervalles entre les seuils. (l'écart est parfois de 20, d'autres de 10, 30, 50, voire même de 130).
De ce fait la ventilation régulière par tranche de 20 ne correspond plus à tes besoins, il faut donc reprendre la macro en intégrant des Select Case comme dans ma première proposition.

En outre, tes différentes feuilles n'ont pas la même longueur. Est-ce logique ou sont-elles formatées sur une configuration rigoureusement identique ?

Je n'ai ni le temps, ni l'envie, de tout reprendre ce soir, je m'y pencherai à nouveau ces jours prochains.

Bonne soirée
Kotov
 
Re : Classer des nombres

Bonsoir Kotov

Pour les nombres j'ai du me tromper, c'est bien la version anterieure qui est la bonne.
Concernant les feuilles la longueur n'est pas la même pour chaque certaines peuvent avoir plus de ligne que d'autres.
Par contre dans la feuille pareto c'est le recapitulatif de l'ensemble des feuilles (DFG et D'F'G') mêmeformat que le fichier "ESSAI" mais avec les tranches de 20.

Merci de ton aide
Je m'excsue encore de t'avoir proposer un fichier incorrect...

@++
Lolo
 
Re : Classer des nombres

Bonsoir Lolo,

Tu trouveras en pièce jointe ton fichier avec la recap dans la feuille "Pareto".
J'ai également modifié les formules des calculs de pourcentages pour éviter des #DIV0! inesthétiques.

En revanche, pour diminuer le poids de ton fichier et le joindre à ce message, j'ai supprimé 2 pages sur 4, ôté les 2 graphiques de la recap, et supprimé toutes les bordures des tableaux.
L'exemple est suffisant pour que tu l'adaptes à ton fichier réel


Pour info, voici le code :
Code:
Dim T() As Variant

Sub VentilNombre()
Dim n&, r&, c&, cc&, i&, x&, xx&, f&, s&
f = ActiveWorkbook.Worksheets.Count
c = 10 'Colonne J
cc = 18 'Colonne R
ReDim T(25, 3) 'Tableau virtuel pour comptage et ventilation
For i = 0 To 25
    T(i, 0) = i * 20
    T(i, 1) = T(i, 0) + 19
Next i

For s = 1 To f 'Pour chaque feuille
Sheets(s).Activate

If Sheets(s).Name <> "Pareto" Then
n = Cells(65536, c).End(3).Row 'Dernière cellule active de la colonne choisie
    'Ventilation des nombres
    For i = 8 To n
        x = Int(Cells(i, c) / 20)
        xx = Int(Cells(i, cc) / 20)
        If x < 25 Then
            T(x, 2) = T(x, 2) + 1
        Else
            T(25, 2) = T(25, 2) + 1
        End If
        If xx < 25 Then
            T(xx, 3) = T(xx, 3) + 1
        Else
            T(25, 3) = T(25, 3) + 1
        End If
    Next i
End If
Next s
Sheets("Pareto").Activate
    'Ecriture des résultats dans un tableau
With ActiveSheet
    For i = 0 To 24
        .Cells(i + 22, 19) = T(i, 0) & " à " & T(i, 1)
        .Cells(i + 22, 20) = T(i, 2)
        .Cells(i + 22, 21) = T(i, 3)
    Next i
    .Cells(47, 19) = T(25, 0) & " et +"
    .Cells(47, 20) = T(25, 2)
    .Cells(47, 21) = T(25, 3)
End With
End Sub

En espérant avoir répondu à tes attentes,
Bonne soirée.

Kotov
 

Pièces jointes

Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

G
  • Question Question
Power Query power query
Réponses
22
Affichages
5 K
G
C
Réponses
1
Affichages
1 K
Cattleya97
C
L
Réponses
2
Affichages
697
Retour