effectuer des regroupement et des comptes (Excel VBA)

poizer · 28 Juillet 2012

Bonjour a tous,
Je suis debutant en Excel VBA et mon pb est peut etre simple pour vous :
je veux effectuer dans une nouvelle feuille des regroupements sur plusieurs colonnes (ex : SECTION et SEXE) et en meme temps faire un comptage en utlisant Excel VBA (voir l'exemple + resultat ci-dessous ou le fichier testCopie.xls attaché (Feuil1 et Feuil2) ).
Merci d'avance

le fichier exemple :
[codetu] [NOM] [SEXE] [Ville] [SECTION]
120 Aaaaaaa M ERRACHIDIA SMAS5
142 Bbbbbbb M KHENIFRA SMPS3/S5
214 Ccccccccc M MEKNES SMPS5
220 Dddddddd F MEKNES SMPS3/S5
285 Iiiiiiiii F SMPS3/S5
322 Kkkkkk M ERRACHIDIA LPAPCES5
331 LLLLL M MEKNES LPAPCES5
518 zzzzzzz M MEKNES SMAS5
524 ttttttt F MEKNES SMAS5
528 qqqqqqq M MEKNES SMAS5
545 vvvvv M ERRACHIDIA SMIAS1/S3
557 oooo M MEKNES SMAS3/S5
570 ssss F MEKNES SMIAS1/S3

le fichier resultat :

[SECTION] [ nb total d'etudiants] [nb total de filles]
LPAPCES5 2 0
SMAS3/S5 1 0
SMAS5 4 1
SMIAS1/S3 2 1
SMPS3/S5 3 2
SMPS5 1 0

Excel-lent · 29 Juillet 2012

Re : effectuer des regroupement et des comptes (Excel VBA)

Bonsoir tout le monde,

Poizer, je ne connais pas ton niveau en VBA, je vais donc partir du fait que tu ne connais que les bases.

Sache que :
-> les macros ci-dessus se lanceront que si tu clic sur un bouton (lié à la macro), ou en passant par le menu "macro".
-> sinon on peut demander à Excel de lancer automatiquement une macro lorsque l'utilisateur :
------- * clic dans une cellule (ou une zone de cellule)
------- * à l'ouverture/fermeture du fichier
------- * si l'utilisateur saisie le mot... dans la cellule ...
------- * à chaque modification effectué par l'utilisateur sur l'onglet ...
------- * ...

A+
Excel-lent

Excel-lent · 29 Juillet 2012

Re : effectuer des regroupement et des comptes (Excel VBA)

Salut JCGL,

JCGL à dit:
Pas analysé ton code...

Je serais toi, je demanderais à ChTi160 des droits d'auteur, car il a plagié ton code 😀

Ormi :
-> l'enlèvement du calcul automatique en début de macro (et réactivation à la fin)
-> la sélection de la feuille2, pour que la macro fonctionne, où qu'elle soit placé

Il a pas changé grand chose 😀

Moi? Une balance??? Si peu lol

Bon WE à tous

poizer · 29 Juillet 2012

Re : effectuer des regroupement et des comptes (Excel VBA)

Merci Excel-Lent pour tes conseils, Ils sont tres frectueux pr moi.
Ca me fait tres plaisir de voir qu'il y a des gens comme vous qui donnent de leur temps pr aider les autres.
A travers ce frum j'ai decouvert la puissance d'Excel que la majorité de presonnes ignorent.
Actuelement je suis entrain de generaliser la solution que JCGL m'a proposée.
Je compterai sur votre aide si jamais je trouve des difficultes.
Je vous souhaite bon week end
Merci encore une autre fois.

Excel-lent · 29 Juillet 2012

Re : effectuer des regroupement et des comptes (Excel VBA)

Hello à tous,

Je dirais même plus, pour aller au bout des choses, personnelement je modifierais la macro de ChTi160 de la façon suivante :

Code:

Sub Récap()
    Dim DerL%, Total%
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual

Sheets("Feuil1").select
With Worksheets("Feuil2")

DerL = .Range("A65536").End(xlUp).Row - 1
              Total = DerL + 1
    .Range("B3:I" & Total).ClearContents
    .Range("C3:C" & DerL).Formula = "=SUMPRODUCT((R2C6:R10000C6=RC1)*(R2C5:R10000C5=1))"
    .Range("D3:D" & DerL).Formula = "=SUMPRODUCT((R2C6:R10000C6=RC1)*(R2C5:R10000C5=2))"
    .Range("E3:E" & DerL).Formula = "=SUMPRODUCT((R2C6:R10000C6=RC1)*(R2C5:R10000C5=3))"
    .Range("G3:G" & DerL).Formula = "=SUMPRODUCT((R2C6:R10000C6=RC1)*(R2C5:R10000C5=1)*(R2C3:R10000C3=""F""))"
    .Range("H3:H" & DerL).Formula = "=SUMPRODUCT((R2C6:R10000C6=RC1)*(R2C5:R10000C5=2)*(R2C3:R10000C3=""F""))"
    .Range("I3:I" & DerL).Formula = "=SUMPRODUCT((R2C6:R10000C6=RC1)*(R2C5:R10000C5=3)*(R2C3:R10000C3=""F""))"
    .Range("B3:B" & DerL).Formula = "=SUM(RC[1]:RC[3])"
    .Range("B" & Total & ":I" & Total).Formula = "=SUM(R[-32]C:R[-1]C)"
    .Range("F3:F" & DerL).Formula = "=SUM(RC[1]:RC[3])"
    .Range("B3:I" & Total).Value = .Range("B3:I" & Total).Value
End With
Sheets("Feuil2").select
   Application.Calculation = xlCalculationAutomatic
   Application.ScreenUpdating = True
End Sub

Ajout de Sheets("Feuil1").select pour éviter les très nombreux Feuil1! présent dans le code de ChTi60 😀

Trêve de taquineries, bon WE à tous

Excel-lent · 29 Juillet 2012

Re : effectuer des regroupement et des comptes (Excel VBA)

Hello,

Tu es nouveau sur le forum, donc ne le sait peut-être pas :
-> il y a sur ce forum beaucoup de spécialiste en VBA, en TCD, en Formule, en Graphique, ... chacun avec ces préférences, domaines de compétence.
-> pour obtenir une réponse plus rapidement, ne jamais poser tes questions à UNE personne. Car les autres passerons leurs chemins. Or ils savent peut-être répondre et auraient pu t'aider. Et la personne que tu interpelle peut très bien ne pas se connecter pendant ... heures/jours/...

Bon courage pour la généralisation du code. Si tu as un soucis d'adaptation, n'hésite pas à demander. Sur ce forum tu trouveras beaucoup de gens à pouvoir t'aider sur ce code, à la porté de très nombreux "VBAiste" (spécialistes du VBA).

De rien.

A+

Excel-lent · 29 Juillet 2012

Re : effectuer des regroupement et des comptes (Excel VBA)

Re,

Suite et fin :

Si cela peux-t'aider voici ci-dessous le code de ChTi160 expliqué

Tu peux copier la macro telle quel dans ton fichier car devant les commentaires j'ai mis le symbole '
Comme tu pourras le constater, dans excel il mettra en vert ces fameuses lignes. Signifiant pour lui qu'il s'agit de commentaire et qu'il ne faut pas en tenir compte.

Autre avantage de laisser les commentaires : si tu reprend ta macro dans plusieurs mois, tu auras peut-être oublié certains truc. Ces commentaires te seront alors d'un grand secours.

VB:

Sub Récap()
'Récap : nom de ta macro
    Dim DerL%, Total%
    'Définir les variables. Dire à excel les données que contiendrons ces variables
    Application.ScreenUpdating = False
    'Dire à excel de figer l'écran. Les informations données par la macro seront misent sur le fichier excel qu'une fois la macro terminé
    'Cela permet à la macro de tourner plus vite
    'Cela évite de voir ta feuille excel bouger toute seul et clignoter : ça fait mal aux yeux :D
    Application.Calculation = xlCalculationManual
    'Enlever le "calcul automatique
    'Permet ainsi à la macro de tourner encore plus vite. D'autant plus intéressant que ta macro va mettre des tonnes de formules.

With Worksheets("Feuil2")
' Chaque fois qu'il y aura un point devant un code, cela voudra dire qu'on travail sur l'onglet "Feuil2"
' Ainsi ton code est plus court, plus lisible, plus facile à comprendre

DerL = .Range("A65536").End(xlUp).Row - 1
'Dans la variable "DerL" mettre le numéro de la dernière ligne de ton tableau en s'aidant de la colonne A pour la trouver
'(on part donc du principe que pour chaque ligne de ton tableau possède TOUT le temps quelque chose dans la colonne A)
'Ainsi si tu agrandis/diminue le nombre de ligne de ton tableau, la macro s'adaptera toute seul à la taille du tableau
'T'évitant ainsi de modifier à chaque fois ta macro
              Total = DerL + 1
              'Mettre dans la variable Total le chiffre contenu dans la variable "DerL", à laquelle on ajoute 1
    .Range("B3:I" & Total).ClearContents
    'Cellule B3 à I (numéro de ligne = dernière ligne de ton tableau + 1) de la "Feuil2" => effacer le contenu
    .Range("C3:C" & DerL).Formula = "=SUMPRODUCT((Feuil1!R2C6:R10000C6=RC1)*(Feuil1!R2C5:R10000C5=1))"
    'Dans les cellules C3 à C (numéro de ligne = dernière ligne de ton tableau) mettre la formule SOMMEPROD...
    'Attention cette formule ne s'adapte pas automatiquement à la taille de ton tableau
    .Range("D3:D" & DerL).Formula = "=SUMPRODUCT((Feuil1!R2C6:R10000C6=RC1)*(Feuil1!R2C5:R10000C5=2))"
    'Idem mais pour la colonne D
    .Range("E3:E" & DerL).Formula = "=SUMPRODUCT((Feuil1!R2C6:R10000C6=RC1)*(Feuil1!R2C5:R10000C5=3))"
    'Idem mais pour la colonne E
    .Range("G3:G" & DerL).Formula = "=SUMPRODUCT((Feuil1!R2C6:R10000C6=RC1)*(Feuil1!R2C5:R10000C5=1)*(Feuil1!R2C3:R10000C3=""F""))"
    .Range("H3:H" & DerL).Formula = "=SUMPRODUCT((Feuil1!R2C6:R10000C6=RC1)*(Feuil1!R2C5:R10000C5=2)*(Feuil1!R2C3:R10000C3=""F""))"
    .Range("I3:I" & DerL).Formula = "=SUMPRODUCT((Feuil1!R2C6:R10000C6=RC1)*(Feuil1!R2C5:R10000C5=3)*(Feuil1!R2C3:R10000C3=""F""))"
    .Range("B3:B" & DerL).Formula = "=SUM(RC[1]:RC[3])"
    .Range("B" & Total & ":I" & Total).Formula = "=SUM(R[-32]C:R[-1]C)"
    .Range("F3:F" & DerL).Formula = "=SUM(RC[1]:RC[3])"
    .Range("B3:I" & Total).Value = .Range("B3:I" & Total).Value
End With
   Application.Calculation = xlCalculationAutomatic
   'Réactiver le "calcul automatique" de ton fichier. Permettant ainsi de calculer en UNE fois, l'ensemble de toutes les formules misent grâce à la macro.
   Application.ScreenUpdating = True
   'Afficher d'un coup toutes les informations sur ton fichier
End Sub

Bonne adaptation.

poizer · 29 Juillet 2012

Re : effectuer des regroupement et des comptes (Excel VBA)

Vous etes vraiement tres gentil et Merci bcp

poizer · 29 Juillet 2012

Re : effectuer des regroupement et des comptes (Excel VBA)

vous etes encore la Excel-lent?

ChTi160 · 29 Juillet 2012

Re : effectuer des regroupement et des comptes (Excel VBA)

Bonjour poizer
Bonjour le Fil
Bonjour le Forum

Arff j’espère ne pas vous réveiller .... Arfff VBa quand tu nous prends Lol

j'ai eu quelques problème avec le Code de Excel-lent #34 , du surement à la suppression de la référence à la feuille source .
donc j'ai modifié ainsi la procédure pour aussi définir la dernière ligne jusqu’où récupérer les Données , plutôt que 10000 , DerLS, f pour la feuille Source et fN pour le nom de la feuille Source

Code:

Sub Récap()
    Dim DerL%, DerlS%, Total%
    Dim f As Worksheet
    Dim fN As String
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual
 
 Set f = Worksheets("feuil1") 'on affecte la feuille source a la variable feuille
 fN = f.Name & "!" 'on récupére le nom de la feuille Source
  DerlS = f.Cells(f.Cells(f.Rows.Count, 1).End(xlUp).Row, 1).Row 'derniere ligne de la feuille Source
With Worksheets("Feuil2") 'avec cette feuille Feuil2

DerL = .Range("A65536").End(xlUp).Row - 1 'on détermine la derniere igne non vide en partant du bas
              Total = DerL + 1 'on défini ou l'on va coller les totaux
    .Range("B3:I" & Total).ClearContents 'on efface la plage des donnees du tableau Cible
    .Range("C3:C" & DerL).Formula = "=SUMPRODUCT((" & fN & "R2C6:R" & DerlS & "C6=RC1)*(" & fN & "R2C5:R" & DerlS & "C5=1))"
  
    .Range("D3:D" & DerL).Formula = "=SUMPRODUCT((" & fN & "R2C6:R" & DerlS & "C6=RC1)*(" & fN & "R2C5:R" & DerlS & "C5=2))"
    .Range("E3:E" & DerL).Formula = "=SUMPRODUCT((" & fN & "R2C6:R" & DerlS & "C6=RC1)*(" & fN & "R2C5:R" & DerlS & "C5=3))"
    .Range("G3:G" & DerL).Formula = "=SUMPRODUCT((" & fN & "R2C6:R" & DerlS & "C6=RC1)*(" & fN & "R2C5:R" & DerlS & "C5=1)*(" & fN & "R2C3:R" & DerlS & "C3=""F""))"
    .Range("H3:H" & DerL).Formula = "=SUMPRODUCT((" & fN & "R2C6:R" & DerlS & "C6=RC1)*(" & fN & "R2C5:R" & DerlS & "C5=2)*(" & fN & "R2C3:R" & DerlS & "C3=""F""))"
    .Range("I3:I" & DerL).Formula = "=SUMPRODUCT((" & fN & "R2C6:R" & DerlS & "C6=RC1)*(" & fN & "R2C5:R" & DerlS & "C5=3)*(" & fN & "R2C3:R" & DerlS & "C3=""F""))"
    .Range("B3:B" & DerL).Formula = "=SUM(RC[1]:RC[3])"
    .Range("B" & Total & ":I" & Total).Formula = "=SUM(R[-32]C:R[-1]C)"
    .Range("F3:F" & DerL).Formula = "=SUM(RC[1]:RC[3])"
    .Range("B3:I" & Total).Value = .Range("B3:I" & Total).Value
End With
   Application.Calculation = xlCalculationAutomatic
   Application.ScreenUpdating = True
End Sub

on pourrait peut être aussi passer par des tableaux(Array) et des evaluate de Fonctions

Bonne journée
aux couches tard Lol
Amicalement
Jean marie

Fo_rum · 29 Juillet 2012

Re : effectuer des regroupement et des comptes (Excel VBA)

Bonjour,

une adaptation de l'adaptation par ChTi160 du code de JCGL pour passer à la TrèsGrandeVitesse 😉.

Code:

Option Explicit


Sub Récap()
  Dim Dl As Long, Ds As Long, Dt As Long
  Dim f As Worksheet
  Dim fN As String
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Set f = Sheets("Feuil1")
  fN = f.Name & "!"
  Ds = f.Cells(f.Cells(f.Rows.Count, 1).End(xlUp).Row, 1).Row
  With Sheets("Feuil2")
    Dl = .Range("A65536").End(xlUp).Row - 1
    Dt = Dl + 1
    .Range("C3") = "=SUMPRODUCT((" & fN & "R2C6:R" & Ds & "C6=RC1)*(" & fN & "R2C5:R" & Ds & "C5=1))"
    .Range("D3") = "=SUMPRODUCT((" & fN & "R2C6:R" & Ds & "C6=RC1)*(" & fN & "R2C5:R" & Ds & "C5=2))"
    .Range("E3") = "=SUMPRODUCT((" & fN & "R2C6:R" & Ds & "C6=RC1)*(" & fN & "R2C5:R" & Ds & "C5=3))"
    .Range("B3") = "=SUM(RC[1]:RC[3])"
    .Range("G3") = "=SUMPRODUCT((" & fN & "R2C6:R" & Ds & "C6=RC1)*(" & fN & "R2C5:R" & Ds & "C5=1)*(" & fN & "R2C3:R" & Ds & "C3=""F""))"
    .Range("H3") = "=SUMPRODUCT((" & fN & "R2C6:R" & Ds & "C6=RC1)*(" & fN & "R2C5:R" & Ds & "C5=2)*(" & fN & "R2C3:R" & Ds & "C3=""F""))"
    .Range("I3") = "=SUMPRODUCT((" & fN & "R2C6:R" & Ds & "C6=RC1)*(" & fN & "R2C5:R" & Ds & "C5=3)*(" & fN & "R2C3:R" & Ds & "C3=""F""))"
    .Range("F3") = "=SUM(RC[1]:RC[3])"
    .Range("B3:I3").AutoFill Destination:=.Range("B3:I34"), Type:=xlFillDefault
    .Range("B" & Dt & ":I" & Dt) = "=SUM(R[-32]C:R[-1]C)"
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    .Range("B3:I" & Dt).Value = .Range("B3:I" & Dt).Value
  End With
End Sub

Pour une lisibilité accrue, je n'écris pas les commentaires dans le code. Je préfère les donner sur un onglet supplémentaire quand la demande en est faite.

effectuer des regroupement et des comptes (Excel VBA)

poizer

Guest

Pièces jointes

Excel-lent

XLDnaute Barbatruc

Excel-lent

XLDnaute Barbatruc

poizer

Guest

Excel-lent

XLDnaute Barbatruc

Excel-lent

XLDnaute Barbatruc

Excel-lent

XLDnaute Barbatruc

poizer

Guest

poizer

Guest

ChTi160

XLDnaute Barbatruc

Fo_rum

XLDnaute Accro

Pièces jointes

Discussions similaires

effectuer des regroupement et des comptes (Excel VBA)

poizer

Guest

Pièces jointes

Excel-lent

XLDnaute Barbatruc

Excel-lent

XLDnaute Barbatruc

poizer

Guest

Excel-lent

XLDnaute Barbatruc

Excel-lent

XLDnaute Barbatruc

Excel-lent

XLDnaute Barbatruc

poizer

Guest

poizer

Guest

ChTi160

XLDnaute Barbatruc

Fo_rum

XLDnaute Accro

Pièces jointes

Discussions similaires

Privacy & Transparency

Privacy & Transparency