Discussion :

[Mimosa777]

Salut a tous et a toutes,

apres plusieurs recherches sur les doublons dans ce forum, je n'arrive pas a trouver un moyen de faire ce qui suit :

J'ai une feuille comme suit :
projet|cout|amortissement|type
projetA|10|5|D
projetB|20|10|F
projetA|25|12|F
projetC|20|10|N

je souhaite simplement recuperer le projet A de la 3eme ligne et l'inclure dans le projetA de la premiere ligne en supprimant la ligne 3 et faisantla somme des colonne 2 et 3 tel que:
projetA|35|17|D
projetB|20|10|F
projetC|20|10|N

Cependant, cela peut arriver aussi bien a des projetB, projetC aussi. Pas juste pour le projetA

Merci d'avance pour toute aide !

[Pierre Fauconnier]

Bonsoir

Il me semble t'avoir répondu il y a peu à une question fort similaire en te proposant des Tableaux Croisés Dynamiques, et tu semblais satisfait de la réponse.

Peux-tu dire en quoi cette demande-ci est différente?

[Mimosa777]

Bonjour Pierre,

simplement parceque je n'ai pas reussi à convaincre l'utilisateur d'utiliser les tableaux croisés dynamique meme si cela est fortement utile. Il désire pouvoir faire cela dans une feuille de donnée normal.

Je n'ai donc pas le choix d'essayer de trouver une alternative. J'ai cependant garder ton exemple pour mes autres macros

[Pierre Fauconnier]

Puisque tes données sont extraites via MSQuery, pourquoi ne pas créer dans une nouvelle feuille une nouvelle requête avec MsQuery qui somme les données en regroupant sur le projet?

Si tu veux vraiment passer par du VBA, je te propose ceci:
Mise en place:
- Un plage nommée avec les résultats de la requête (voir mes réponses sur ton autre discussion). Dans ce cas, j'ai nommé la plage ReqProjets et elle prend toutes les données de la feuille qui récupère les données via MSQuery
- La feuille des données a shDonnees comme propriété CodeName (Nom de la feuille dans le projet VBA <> Nom de la feuille Excel (propriété Name)) *
- La feuille récapitulative a shRecap comme propriété CodeName

Avec cette mise en place, tu peux étudier le code suivant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Sub Regroupement()
    VidangerFeuilleRecapitulative
    CreerListeProjetsRecap
    CreerFormulesRecap
End Sub
 
Sub VidangerFeuilleRecapitulative()
    shRecap.Range(shRecap.Cells(2, 1), shRecap.Cells(Rows.Count, Columns.Count)).ClearContents
End Sub
 
Sub CreerListeProjetsRecap()
    Dim oDico As Scripting.Dictionary
    Dim i As Integer
 
    Set oDico = ListeProjets()
    For i = 0 To oDico.Count - 1
        shRecap.Range("a" & Rows.Count).End(xlUp)(2).Value = oDico.Items(i)
    Next i
End Sub
 
Function ListeProjets() As Scripting.Dictionary
    Dim Cellule As Range
    Dim oDico As New Scripting.Dictionary
 
    For Each Cellule In shDonnees.Range("a2:a" & shDonnees.Range("a" & Rows.Count).End(xlUp).Row)
        If Not oDico.Exists(Cellule.Value) Then oDico.Add Cellule.Value, Cellule.Value
    Next Cellule
    Set ListeProjets = oDico
    Set oDico = Nothing
End Function
 
Sub CreerFormulesRecap()
    shRecap.Range("b2").Formula = "=SUMIF(OFFSET(ReqProjets,0,0,,1),A2,OFFSET(ReqProjets,0,1,,1))"
    shRecap.Range("c2").Formula = "=SUMIF(OFFSET(ReqProjets,0,0,,1),A2,OFFSET(ReqProjets,0,2,,1))"
    shRecap.Range("b2:c2").Copy Destination:=shRecap.Range("b2:b" & shRecap.Range("a" & Rows.Count).End(xlUp).Row)
    shRecap.Range("b2:c" & shRecap.Range("a" & Rows.Count).End(xlUp).Row).Copy
    shRecap.Range("b2:c" & shRecap.Range("a" & Rows.Count).End(xlUp).Row).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
End Sub

* Utiliser la propriété CodeName permet d'avoir des macros qui fonctionnent même si l'utilisateur modifie le nom de l'onglet.

L'utilisation d'un dictionnaire de la librairie Scripting permet d'éviter les doublons et propose la liste triée, ce qui est simple à utiliser. Il faut néanmoins cocher la référence à Microsoft Scripting Runtime.

Reviens pour détails, explications ou compléments d'info

PS: On aurait pu tout mettre dans une même procédure, mais je préfère travailler avec des (très) petites briques et les assembler ensemble. C'est plus facile à déboguer, surtout quand on remet l'ouvrage sur le métier après quelques mois pour le modifier...

[Mimosa777]

Salut Pierre,

j'ai testé ton code et cela marche tres bien sauf pour une chose que moi j'ai oublie de préciser et m'excuse d'avance.

Ceci etant dit, lorsqu'il y a un projetA avec le type D et F, on s'assure que nous concatenons les donnees du projetA,type F dans celui du projetA,type D. Ce que ta procédure fait tres bien. Mais le probleme, c'est qu'il ne doit pas concatener aussi les projetA, type N avec ceux du type D ou F, jamais. Pareil pour les projetB, projetC, etc. Seulement les memes projets du type D et F seulement qui se concatene et en aucun cas les types N le sont.

Il y a aussi les exceptions ou la concatenation ne peut tout simplement jamais etre fait sur certains projets. je dois pouvoir donc ajouter une exception dans le code qui précise que pour un projetX par exemple, aucune concatenation ne sera faite sur ce projet meme s'il apparait deux fois dans la liste dans les types D et F.

Afin de voir plus clair ce que j'essaie de faire, j'ai repris ton code qui fonctionne a merveille et modifier la plage de données avec des données réelles de mon application, tu remarqueras alors que pour un meme projet sous les types D et F, la concatenation se fait bien, mais il faut simplement ne pas inclure les types N. Il y a aussi un projet en exception, soit le projet BCAR qui lui, doit tout simplement rester tel quel sous les types D et F sont etre jumelés.

Voir fichier

Merci enormément pour ton aide, cela est très apprécié Pierre. Par ailleurs, j'ai aussi ce code plus simple qui marche très bien à l'exception de la concaténation qui se fait pas du tout entre les types F et D si jamais cela t'intéresses de voir.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub traitement()
    Dim i, j As Integer
    Dim typeProjet, typeLettre As String
    i = 1
    j = 1
    typeProjet = ""
    typeLettre = ""
    While Trim(Sheets("Sheet2").Cells(i, 1).Value) <> ""
        If typeProjet <> Sheets("Sheet2").Cells(i, 1).Value Or typeLettre <> Sheets("Sheet2").Cells(i, 4).Value Then
            Sheets("Sheet3").Cells(j, 1).Value = Sheets("Sheet2").Cells(i, 1).Value
            Sheets("Sheet3").Cells(j, 2).Value = Sheets("Sheet2").Cells(i, 2).Value
            Sheets("Sheet3").Cells(j, 3).Value = Sheets("Sheet2").Cells(i, 3).Value
            Sheets("Sheet3").Cells(j, 4).Value = Sheets("Sheet2").Cells(i, 4).Value
            typeProjet = Sheets("Sheet2").Cells(i, 1).Value
            typeLettre = Sheets("Sheet2").Cells(i, 4).Value
            j = j + 1
        Else
            Sheets("Sheet3").Cells(j - 1, 2).Value = Sheets("Sheet3").Cells(j - 1, 2).Value + Sheets("Sheet2").Cells(i, 2).Value
            Sheets("Sheet3").Cells(j - 1, 3).Value = Sheets("Sheet3").Cells(j - 1, 3).Value + Sheets("Sheet2").Cells(i, 3).Value
        End If
        i = i + 1
    Wend
End Sub

[Pierre Fauconnier]

Je reste avec mon code (peut-être moins simple, mais à mon sens plus lisible et plus maintenable...), car avec le tien, je ne vois nulle part le fait que la feuille récap est nettoyée et que les nouveaux projets qui arriveraient du MSQuery sont bien dans la feuille récap, ce qui veut dire qu'il faut soit les ajouter (ou les retirer) à la main (risques d'erreur ou d'oubli), soit créer une autre procédure pour les ajouter ou les retirer.

Je réitère ma question: Pourquoi ne pas passer aussi par MSQuery pour le récap? Toutes les conditions que tu donnes ici sont très simplement transposables en MSQuery (sauf peut-être pour l'exclusion de certains projets, en fonction de la structure des données source et des possibilités de signaler ces projets comme "exclus" à la source)...

Soit.
Tu as vu dans mon code les trois étapes...
La première ne change pas.

Pour la deuxième, il faut exclure de l'ajout dans la liste les projets que l'on ne veut pas reprendre. Idéalement, ces projets se trouveront dans une plage nommée, et il suffira, avant d'ajouter un projet au dictionnaire, de vérifier qu'il n'est pas dans la liste des exclus. D'où l'intérêt de mon code par petits bouts et des plages nommées.
Voici la procédure modifiée

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Function ListeProjets() As Scripting.Dictionary
    Dim Cellule As Range
 
    Dim oDico As New Scripting.Dictionary
 
    For Each Cellule In shDonnees.Range("a2:a" & shDonnees.Range("a" & Rows.Count).End(xlUp).Row)
        If Application.WorksheetFunction.CountIf(Range("projetsexclus"), Cellule.Value) = 0 Then _
        If Not oDico.Exists(Cellule.Value) Then oDico.Add Cellule.Value, Cellule.Value
    Next Cellule
    Set ListeProjets = oDico
    Set oDico = Nothing
End Function

Pour ce qui est de la troisième étape. Pour éviter les boucles qui sommeront les valeurs, j'ai créé en VBA une formule de type SOMME.SI. S'il y a plus qu'une condition, il faut alors créer une formule de type SOMMEPROD
Voici la procédure modifiée

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Sub CreerFormulesRecap()
    shRecap.Range("b2").Formula = "=SUMPRODUCT((OFFSET(ReqProjets,0,0,,1)=A2)*(OFFSET(ReqProjets,0,3,,1)<>""N"")*(OFFSET(ReqProjets,0,1,,1)))"
    shRecap.Range("c2").Formula = "=SUMPRODUCT((OFFSET(ReqProjets,0,0,,1)=A2)*(OFFSET(ReqProjets,0,3,,1)<>""N"")*(OFFSET(ReqProjets,0,2,,1)))"
    shRecap.Range("b2:c2").Copy Destination:=shRecap.Range("b2:b" & shRecap.Range("a" & Rows.Count).End(xlUp).Row)
    shRecap.Range("b2:c" & shRecap.Range("a" & Rows.Count).End(xlUp).Row).Copy
    shRecap.Range("b2:c" & shRecap.Range("a" & Rows.Count).End(xlUp).Row).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
End Sub

Voilà le fichier sur lequel j'ai mis cela en place