compter le nombre de dates identiques avec une macro

controlo

XLDnaute Occasionnel
Bonjour les amis ,

Je souhaiterais dans le fichier ci-joint compter combien il y a de dates identiques et l'afficher dans une message box.J'ai commencé un bout de macro ,mais je sèche pour retrancher le nombre de dates déjà comptées.Si vous pouviez me donner un petit coût de main ce serait sympa.

Merci de votre aide.
 

Pièces jointes

  • essai 17-05-12.xls
    22.5 KB · Affichages: 40

Efgé

XLDnaute Barbatruc
Re : compter le nombre de dates identiques avec une macro

Bonjour controlo
il y a beaucoup d'exemples sur le forum.
Regarde ceci:
VB:
Sub Macro2()
Dim i&, D As Object, C As Variant
Set D = CreateObject("Scripting.dictionary")
With Sheets("Feuil1")
    For i = 10 To .Cells(Rows.Count, 1).End(xlUp).Row
        D(.Cells(i, 1).Value) = D(.Cells(i, 1).Value) + 1
    Next i
End With
For Each C In D.Keys
    MsgBox D(C) & " du " & C, vbYes, "demo"
Next C
End Sub

Pour tout savoir sur les dictionnaires, va sur le site de J.Boisgontier

Cordialement

EDIT Bonjour Jc:)
 
Dernière édition:

JCGL

XLDnaute Barbatruc
Re : compter le nombre de dates identiques avec une macro

Bonjour à tous,

Pas une boite de message mais en D et E...
Dans un module standard :

VB:
Sub Compter_Date()
    Dim Coll As Collection
    Dim Lig As Long, DerL As Long
    Dim Compteur As Long


    ' ligne de début du tableau colonne A
    Lig = 10
    'ligne de fin
    DerL = Range("A65536").End(xlUp).Row
    Columns(4).ClearContents
    Columns(5).ClearContents
    'collecte les données sans doublons
    Set Coll = New Collection
    For Compteur = Lig To DerL
        On Error Resume Next
        Coll.Add Cells(Compteur, 1).Value, Cells(Compteur, 1).Text
        On Error GoTo 0
    Next


    For Compteur = 1 To Coll.Count
        'restitue chaque donnée dans colonne D
        Cells(Compteur + 1, 4) = Coll(Compteur)
        'indique le nombre d'occurrences de la donnée dans colonne E
        Cells(Compteur + 1, 5) = Application.CountIf(Range(Cells(Lig, 1), Cells(DerL, 1)), Cells(Compteur + 1, 4))
    Next


    Set Coll = Nothing
    [A1].Select
    End Sub

A + à tous

Edition : Salut l'ami Fred...
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 177
Messages
2 085 972
Membres
103 073
dernier inscrit
MSCHOE16