Compter le nombre d'occurence sur 2 colonnes en vba

[Alza]

Bonjour à tous,
J'ai un problème que je suppose assez simple mais la solution m'échappe ..
Mes explications vont concerner le fichier joint pour que ce soit plus clair.
La feuil1 représente la base de données, la feuil2 représente le résultat que je souhaite obtenir.
J'ai des agents (col A) qui ont des affaires (associations col B et C) et ces affaires ont une date de début (col D).
Je souhaite avoir pour chaque agent son nombre d'affaires par processus et libelle. Le nombre total d'un coté et le nombre en cours dans une période qui sera sélectionné par l'utilisateur.
Petit exemple :
Dans la feuil de données il y a une ligne ou Jean a le processus a en col B et le libelle b en col C.
Le résultat sera donc Jean | ab | 1
Si il y a une seconde ligne identique le résultat est :
Jean | ab | 2
Par contre si il y a processus a et libelle d ce sera une nouvelle ligne tel que :
Jean | ad | 1
si bd
Jean | bd | 1
etc ..
Je pense être capable d'appliquer le tri par agent et par date mais je bloque sur le compte du nombre d'association B|C ..

Infos supplémentaires :
- La feuil1 d'origine contient environ 30 000 lignes, il faut donc une méthode rapide
- J'aimerai que le résultat soit trié par ordre alphabétique

Merci d'avance pour vôtre aide,
Alza

 

[thebenoit59]

Bonjour Alza.

Comment détermines-tu la période désirée ?

 

[Alza]

Bonjour thebenoit59,

La période désirée sera demandée à l'utilisateur via un DTpicker pour la date de début et une durée via une textbox, je calcule une date de fin en ajoutant la durée à la date de début. Dans le programme il faut donc compter chaque affaire pour laquelle date début > date du DT et < dateFin.

 

[thebenoit59]

Une première solution.
En essayant de la décomposer au maximum pour que tu t'y retrouves.

 

[Alza]

Bonjour thebenoit59,
Super c'est exactement l'idée ! Par contre il y a une erreur quand je passe sur mes vraies données dans :

 For Each c In d1.keys
        a = Split(c, ":")
        If i > 1 Then
            If Agent = a(0) Then
                Total = False
                Else
                Total = True
            End If
        End If
        If Total = True Then
            temp(i, 1) = "Total"
            temp(i, 3) = j
            temp(i, 4) = k
            i = i + 1
            j = 0
            k = 0
        End If
            If i > 1 And Total = False Then
                temp(i, 1) = ""
                Else
                temp(i, 1) = a(0)
            End If
            temp(i, 2) = a(1)
            temp(i, 3) = d1(c): j = j + d1(c)
            temp(i, 4) = d2(c): k = k + d2(c)
            i = i + 1
            Agent = a(0)
    Next c

J'ai 23 items dans c, 38 dans temps mais au 21ème item de c, i est déjà rendu à 39, l'indice temp(i, 1) n'appartient donc plus à la sélection, une idée d’où peut venir l'incrémentation de trop ?

Un autre détail pour que ce soit parfait : il faudrait que les typologies d'affaires soient triées par ordre alphabétique. Je pense qu'il faut faire ça tout à la fin sur le tableau des résultats mais je ne sais pas comment effectuer un tri sur une colonne sans perdre l'indexation avec les autres colonnes ?

Un grand merci pour ton aide !

 

[thebenoit59]

Bonjour Alza, pourrais-tu me faire parvenir le fichier sur lequel tu travailles ?
Ca sera plus simple pour comprendre le problème.

 

[Alza]

J'essaie de reproduire l'erreur sur un fichier test, je ne peux malheureusement pas fournir la totalité des données.

Edit : Bon il semble que l'erreur vienne des noms en les changeants par des lettres uniques elle a disparue, je vais creuser ça

Edit2 : Ca a un rapport avec le tri, quand mes données sont triées par ordre alphabétique sur le nom de l'agent cela fonctionne par contre dans le cas contraire cela ne fonctionne pas

 

[Alza]

Voici un fichier test contenant le bug :

 

[thebenoit59]

Le soucis provenait de la liste, sur le premier fichier chaque tâche se succède pour les agents et pas dans le second fichier, alors ça crée des lignes de totaux inutiles et donc incrémente la valeur i.

J'ai corrigé ça avec l'aide des fonctions du site de Boisgontier. Cela a également permis de trier par typologie en ordre alphabétique.

J'espère que sur ce coup ci ça fonctionne.

 

[Alza]

Désolé pour l'erreur sur le fichier test, je me disais bien que j'avais oublié un cas mais je ne voyais pas lequel.
Cette fois ci cela fonctionne parfaitement ! Merci beaucoup pour ton aide, j'avais déjà essayé de le faire par moi même en utilisant les même méthodes que toi mais j'ai encore du mal avec les logique des tableaux et des dicos qui s'imbriquent ainsi
J'essaierai de me baser sur ton code pour en apprendre d'avantage !

 

[thebenoit59]

Content que ça fonctionne comme tu le souhaites.
Au moins, avec le système de tri les erreurs devront être évitées.

 

[Alza]

Bon je vais t'embêter une dernière fois (j'espère) ..
Les colonnes de données dans mon tableau d'origine sont séparées par d'autre colonnes, j'ai donc essayé de remplir t() en bouclant sur les lignes mais cela prend 1 seconde
Ma question est donc la suivante :
Y a t-il un moyen pour remplir les colonnes d'un tableau de la même façon qu'avec range mais colonne par colonne ?
Quelque chose comme t.columns(1) = [A:A] ?

 

[thebenoit59]

Oui il y a possibilité de transférer des colonnes discontinues dans un tableau mais ce n'est pas utile.
Tu peux enregistrer tout ton tableau et modifier les numéros de colonne dans le reste du code.

 

[Alza]

Bonjour,
J'ai fais comme ça du coup, merci !

 

[klin89]

Bonjour à tous,

Pour le fun, vois cette version, j'utilise un dictionnaire principal et un sous dictionnaire
Je n'ai pas trié la base initiale comme thebenoit59
J'ai codé en dur les dates de début et fin pour l'exemple
C'est facilement transposable avec le code de thebenoit59

Option Explicit
Sub test()
Dim a, w(), i As Long, n As Long, e, txt As String
Dim Debut As Date, Fin As Date, dico As Object
    a = Sheets("Base").Cells(1).CurrentRegion.Value
    Debut = CDate("05/03/2016"): Fin = CDate("30/03/2016")
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    For i = 2 To UBound(a, 1)
        If Not dico.exists(a(i, 1)) Then
            Set dico(a(i, 1)) = _
            CreateObject("Scripting.Dictionary")
            dico(a(i, 1)).CompareMode = 1
        End If
        txt = Join(Array(a(i, 2), a(i, 3)), "")
        If Not dico(a(i, 1)).exists(txt) Then
            If dico(a(i, 1)).Count = 0 Then
                dico(a(i, 1))(txt) = VBA.Array(a(i, 1), txt, 1, IIf(a(i, 4) >= Debut And a(i, 4) <= Fin, 1, Empty))
            Else
                dico(a(i, 1))(txt) = VBA.Array(Empty, txt, 1, IIf(a(i, 4) >= Debut And a(i, 4) <= Fin, 1, Empty))
            End If
        Else
            w = dico(a(i, 1))(txt)
            w(2) = w(2) + 1
            If a(i, 4) >= Debut And a(i, 4) <= Fin Then w(3) = w(3) + 1
            dico(a(i, 1))(txt) = w
        End If
    Next
    Application.ScreenUpdating = False
    With Sheets("Feuil1").Cells(1)
        .CurrentRegion.Clear: n = 1
        .Resize(1, 4).Value = [{"Agent","Typologie d'affaire","Nombre d'affaires total","Nombre d'affaires sur la période entrée"}]
        For Each e In dico.keys
            With .Offset(n).Resize(dico(e).Count, 4)
                .Value = Application.Transpose(Application.Transpose(dico(e).items))
                With .Offset(dico(e).Count).Resize(1)
                    .Interior.ColorIndex = 36
                    .BorderAround Weight:=xlThin
                    .Cells(1, 1) = "Total " & e
                    .Cells(1, 2) = dico(e).Count
                    .Cells(1, 3) = Application.Sum(Application.index(dico(e).items, 0, 3))
                    .Cells(1, 4) = Application.Sum(Application.index(dico(e).items, 0, 4))
                End With
                n = n + dico(e).Count + 1
            End With
        Next
        With .CurrentRegion
            .Font.Name = "calibri"
            .Font.Size = 10
            .VerticalAlignment = xlCenter
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            With .Rows(1)
                .Font.Size = 11
                .HorizontalAlignment = xlCenter
                .BorderAround Weight:=xlThin
                .Interior.ColorIndex = 40
            End With
            .Columns.AutoFit
        End With
        .Parent.Activate
    End With
    Application.ScreenUpdating = True
    Set dico = Nothing
End Sub

klin89