XL 2010 compter masculin feminin

Modeste geedee

XLDnaute Barbatruc

• 10 Juillet 2017

• #2

jean123 à dit:

bonjour à tous, j'ai un tableau de 50 000 lignes environ et qui grossie au fur et à mesure

dans ce tableau j'ai des dates colonne A et une colonne (D) sexe "m" et "f"

j'aimerais si possible en vba pouvoir compter le nombre de "m" pour chaque date et le nombre de "f" pour chaque date

un grand merci pour votre aide

Cliquez pour agrandir...

Tableau croisé dynamique...

 

Vote positif 0 Vote négatif

jean123

XLDnaute Occasionnel

• 10 Juillet 2017

• #3

c'est pas faux j'avais juste oublié en vba

 

Vote positif 0 Vote négatif

pierrejean

XLDnaute Barbatruc

• 10 Juillet 2017

• #4

Bonjour jean123
Salut Modeste

Tu nous poste un petit fichier avec une 10 aine de lignes S.T.P

 

Vote positif 0 Vote négatif

jean123

XLDnaute Occasionnel

• 10 Juillet 2017

• #5

je joint le fichier exemple

 

Pièces jointes

• test date.xlsx

  8 KB · Affichages: 39

Vote positif 0 Vote négatif

pierrejean

XLDnaute Barbatruc

• 10 Juillet 2017

• #6

Re

Un essai

 

Pièces jointes

• test date.xlsm

  20.5 KB · Affichages: 53

Vote positif 0 Vote négatif

jean123

XLDnaute Occasionnel

• 10 Juillet 2017

• #7

super ça marche parfaitement (et rapide en plus) un grand merci j'aurais un dernier petit truc a te demander
papou-net m'a fait une macro qui marche très bien et je l'en remercie mais qui a un temps d’exécution relativement long (4 min en moyenne)
pourrais tu y jeter un œil

Code:

Sub test() 
With Feuil1
  .Range("J:K").ClearContents
  lg = 1
  For Each Cel In .Columns(1).SpecialCells(xlCellTypeConstants)
    If Cel <> Cel.Offset(1, 0) And .Columns(10).Find(Cel, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
      .Range("J" & lg) = Cel
      lg = lg + 1
    End If
  Next
  For Each Cel In .Columns(1).SpecialCells(xlCellTypeConstants)
    Set dte = .Columns(10).Find(Cel, LookIn:=xlValues, LookAt:=xlWhole)
    If Not dte Is Nothing Then
      If Cel.Offset(, 1) <> "" Then dte.Offset(, 1) = dte.Offset(, 1) + 1
    End If
  Next
End With
End Sub

un gros merci a toi

 

Vote positif 0 Vote négatif

pierrejean

XLDnaute Barbatruc

• 11 Juillet 2017

• #8

Re
La encore un petit fichier exemple serait souhaitable

 

Vote positif 0 Vote négatif

phlaurent55

Nous a quittés en 2020

Repose en paix

• 11 Juillet 2017

• #9

Bonjour à tous,

une version TCD en pièce jointe

à+
Philippe

 

Pièces jointes

• 111.xlsm

  18.4 KB · Affichages: 31

Vote positif 0 Vote négatif

phlaurent55

Nous a quittés en 2020

Repose en paix

• 11 Juillet 2017

• #10

Re,

Il ne faut pas s'étonner de la longueur de la procédure lorsque l'on a 50.000 lignes à traiter.
Il y a sans doute une solution qui passe par l'utilisation d'un dico mais ça je ne sais pas le faire

À+
Philippe

 

Vote positif 0 Vote négatif

Papou-net

XLDnaute Barbatruc

• 11 Juillet 2017

• #11

Bonjour à tous,

Voici ma version initiale modifiée, avec utilisation d'un dictionary.

A vérifier si la rapidité est satisfaisante sur 50000 lignes?

Cordialement.

 

Pièces jointes

• Copie 01 de Exemple Jean123.xlsm

  20.2 KB · Affichages: 45

Vote positif 0 Vote négatif

pierrejean

XLDnaute Barbatruc

• 12 Juillet 2017

• #12

Bonjour jean123
Salut Papou-net

Je n'ai peur-etre pas tout compris mais je crois que ceci serait plus simple (fichier de Papou-net)
A tester:

Code:

Sub recap1()
Set monDico = CreateObject("Scripting.Dictionary")
tablo = Range("A1:B" & Range("A" & Rows.Count).End(xlUp).Row)
For n = LBound(tablo, 1) To UBound(tablo, 1)
  x = tablo(n, 1)
  If tablo(n, 2) <> "" Then monDico(x) = monDico(x) + 1
Next
a = monDico.keys
b = monDico.items
Range("D1").Resize(UBound(a) + 1) = Application.Transpose(a)
Range("E1").Resize(UBound(b) + 1) = Application.Transpose(b)

End Sub

 

Vote positif 0 Vote négatif

Papou-net

XLDnaute Barbatruc

• 13 Juillet 2017

• #13

RE

Bonsoir Jean123, Philippe, pierrejean,

Ton code paraît effectivement plus simple et fonctionne parfaitement dans l'état actuel du fichier. Mais, si l'on ajoute des dates dans la colonne A, l'affichage ne se fait pas ou avec des erreurs.

Cordialement.

 

Vote positif 0 Vote négatif

pierrejean

XLDnaute Barbatruc

• 13 Juillet 2017

• #14

Re

Il y avait effectivement un problème (la classique inversion des jours et mois)
Cette version devrait être meilleure
Il reste à la jauger au point de vue vitesse d’exécution

 

Pièces jointes

• Copie 01 de Exemple Jean123.xlsm

  21.7 KB · Affichages: 43

Vote positif 0 Vote négatif

jean123

XLDnaute Occasionnel

• 24 Juillet 2017

• #15

désolé pour la réponse tardive
super ça marche nickel
par contre j'ai un petit souci qui vient de mes données:
les dates que j'ai en colonne A certaine sont au format date et d'autre format texte je pense (il faut que je clic 2 fois dans la cellule pour que la date soit au format date )
j'ai essayé plein de chose mais en vain je ne vois pas comment toutes les passer en date si ce n'est de cliquer cellule par cellule
du coup la macro bloque sur ça aussi pfff
là je bloque !

 

Vote positif 0 Vote négatif