Extraction de donnée.

[lelukois]

Bonjour, je reviens vers vous car l'année prochaine je suis bénévole dans une association pour les dons de sang. Le président ma demandé de refaire leur tableau sous Excel 2007 pour gérer les donneurs (leur ancien tableau étant très mal fait). Mon tableau fonctionne très bien (macro pour les filtres etc...). Il est construit avec 8 onglets, 5 onglets pour les collectes de sang (max 100 donneurs par collecte et 5 collectes par an), un pour les statistiques, un pour les graphiques et un que j'ai nommé BDD.
J'aimerais savoir si dans l'onglet statistique, il était possible d'avoir un formule, une macro qui permettrait a Excel 2007 d'extraire dans les 5 onglets collecte les noms, prénoms, Reh, tel et communes et le nombre de fois que chaque donneur est venu au collecte. J'ai besoin de cela pour identifier les donneurs qui viennent souvent et ceux qui ne viennent que une fois ou deux au collecte. Cela permettrait au président en un coup d’œil de voir l'assiduité des donneurs comme cela il pourra remercier les donneurs assidu et motiver ceux qui on moins donner et aussi en cas de demande des hôpitaux de Reh spécifique d'identifié très rapidement les Reh pour appeler les donneurs en fonction de la demande. Je joins le tableau pour le don de sang pour que vous rendiez compte de ma demande avec des données complètement factice. En sachant aussi que certains donneurs porte le même nom et prénom (pas de la même famille) des Reh différents ou non et de commune différente et qu'il vienne a une, deux, trois, quatre ou 5 collectes dans un ordre aléatoire.
J'espère me faire comprendre, je me tiens a votre disposition pour tout renseignement complémentaire.

En vous remerciant par avance.

 

[Paf]

Bonjour lelukois,

un essai macro :

Sub Extract()
Dim T, Feuille, dico, i As Long, DerL As Integer, Clé, T2, TmP, x As Integer

Set dico = CreateObject("Scripting.Dictionary")

Feuille = Array("1ere collecte", "2eme collecte", "3eme collecte", "4eme collecte", "5eme collecte")
For Each sh In Feuille
    DerL = Worksheets(sh).Range("B" & Rows.Count).End(xlUp).Row
    If DerL > 1 Then
        T = Worksheets(sh).Range("B3:F" & DerL)
        For i = LBound(T, 1) To UBound(T, 1)
            Clé = T(i, 1) & "|" & T(i, 2) & "|" & T(i, 3) & "|" & T(i, 4) & "|" & T(i, 5)
            dico(Clé) = dico(Clé) + 1
        Next
    End If
Next
ReDim T2(1 To dico.Count, 1 To UBound(T, 2) + 1)
For Each Clé In dico.keys
    x = x + 1
    TmP = Split(Clé, "|")
    For i = LBound(TmP) To UBound(TmP)
        T2(x, i + 1) = TmP(i)
    Next
    T2(x, UBound(TmP) + 2) = dico(Clé)
Next
Worksheets("Statistiques").Range("A2").Resize(UBound(T2, 1), UBound(T2, 2)) = T2
End Sub

A+

 

[lelukois]

Re, super cela fonctionne encore merci. Je vois avec mon président si le tableau lui convient. Encore mille merci.