Bonjour,

Je me permet d'ouvrir un discussion concernant un problème de codage VBA.

Tout d'abord, le contexte : J'ai un tableau de données dans lequel chaque élément est identifié par un code ouvrage, cependant plusieurs lignes peuvent avec le même code ouvrage peuvent être présentes. Je dois réussir à synthétiser ce tableau pour obtenir seulement une seule ligne pour chaque code ouvrage pour pouvoir par la suite exploiter les données.

J'avais dans un premier temps utiliser l’enregistreur de macro pour créer un Tableau Croisé Dynamique, ce qui me permettait de filtrer et regrouper les données. Le problème de cette première solution est que pour les 3 premières catégories (hauteur, épaisseur et diamètre) il me faut une moyen, mais pas une moyen arithmétique comme le fait un TCD, j'ai besoin d'une moyenne pondérée.

J'ai alors essayé de créer une macro me permettant de synthétiser mon premier tableau en faisant les moyennes pondérées cependant je bloque sur la définition des plages de donné et autre. En effet, je me suis dit que j'allais définir des plages pour pouvoir ensuite les réutiliser dans mes fonctions (je n'arrive pas à utiliser les compteurs que j'ai créé pour les mettre dans des Range ou dans les formules). Cependant étant donné que j'utilise un boucle et que je renomme mes plages à chaque fois, à la fin de mon programme les premières ligne de synthèse utilise les dernières définition de plage.

Je souhaites donc trouver une solution pour pouvoir définir les bonnes plage de données dans ma formule de moyenne pondérée.

Je vous remercie.
Je vous met en copie mon code ainsi que mon fichier pour une meilleur compréhension. (Excusez moi par avance pour la qualité du code, je ne suis encore qu'un débutant ahah)

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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
 
Sub test2()
 
Sheets("Feuil11").Activate
Z = 4
t = Z + 1
Range("d" & Z).Select
 
While Not IsEmpty(Range("d" & Z))
    If Range("d" & Z) <> Range("d" & t) Then
        Rows(Z).Copy
        Sheets("feuil12").Activate
        Rows(Z).Select
        ActiveSheet.Paste
        Z = Z + 1
        t = Z + 1
 
        Sheets("feuil11").Activate
        Range("d" & Z).Select
 
    Else
    r = Z
    Z = Z + 1
    t = Z + 1
        While Range("d" & Z) = Range("d" & t)
            Z = Z + 1
            t = Z + 1
        Wend
    [ATTACH]385886[/ATTACH][ATTACH]385886[/ATTACH]
    Range("E" & r).Select
    Range(ActiveCell, "e" & Z).Select
    Selection.Name = "ma_plage_0"
 
    Range("F" & r).Select
    Range(ActiveCell, "F" & Z).Select
    Selection.Name = "ma_plage_1"
 
    Range("G" & r).Select
    Range(ActiveCell, "G" & Z).Select
    Selection.Name = "ma_plage_2"
 
    Range("h" & r).Select
    Range(ActiveCell, "h" & Z).Select
    Selection.Name = "ma_plage_3"
 
    Range("i" & r).Select
    Range(ActiveCell, "i" & Z).Select
    Selection.Name = "ma_plage_4"
 
    Range("j" & r).Select
    Range(ActiveCell, "j" & Z).Select
    Selection.Name = "ma_plage_5"
 
    Range("k" & r).Select
    Range(ActiveCell, "k" & Z).Select
    Selection.Name = "ma_plage_6"
 
    Range("a" & r, "d" & r).Copy
    Sheets("feuil12").Select
    Range("a" & r).Select
    ActiveSheet.Paste
 
    Range("e" & r).Select
    ActiveCell.Formula = "=SUMPRODUCT(ma_plage_0,ma_plage_4)/SUM(ma_plage_4)"
 
    Range("f" & r).Select
    ActiveCell.Formula = "=SUMPRODUCT(ma_plage_1,ma_plage_4)/SUM(ma_plage_4)"
 
    Range("g" & r).Select
    ActiveCell.Formula = "=SUMPRODUCT(ma_plage_2,ma_plage_4)/SUM(ma_plage_4)"
 
    Range("h" & r).Select
    ActiveCell.Formula = "=sum(ma_plage_3)"
 
    Range("i" & r).Select
    ActiveCell.Formula = "=sum(ma_plage_4)"
 
    Range("j" & r).Select
    ActiveCell.Formula = "=sum(ma_plage_5)"
 
    Range("k" & r).Select
    ActiveCell.Formula = "=sum(ma_plage_6)"
 
 
 
    Sheets("feuil11").Activate
    Range("d" & Z).Select
 
    End If
 
Wend
 
Sheets("feuil12").Select
Range("E3:E1000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub