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
|
Option Explicit
Sub ListeSansDoublon()
Dim DerLi As Integer
Dim monDico As Object
Dim i As Integer
Dim maStr As Variant
Dim TableauSansDoublon() As Variant
Dim a As Variant
Dim Sh1 As Worksheet
Dim Sh2 As Worksheet
Dim Lico As String
Dim Ref As String
Dim Design As String
Dim SS As String
Dim Total_2008 As String
Dim DerLiReport As Integer
Dim Calc As String
Set Sh1 = Sheets("FM Run")
Set Sh2 = Sheets("FM Report")
DerLi = Sh1.Columns(2).Find("*", , , , , xlPrevious).Row
'on efface les données précédentes
Sh2.Range(Rows("4:4"), Rows("4:4").End(xlDown)).ClearContents
Calc = Application.Calculation
Application.Calculation = xlManual
Application.ScreenUpdating = False
Set monDico = CreateObject("scripting.dictionary")
' Remplissage du dictionnaire
For i = 2 To DerLi
maStr = Sh1.Cells(i, 2) & "/" & Sh1.Cells(i, 3) & "/" & Sh1.Cells(i, 4)
If Not monDico.exists(maStr) Then monDico.Add maStr, maStr
Next i
a = monDico.items
'on place les données sans doublon sur la feuille Report
For i = 0 To monDico.Count - 1
maStr = Split(a(i), "/")
Sh2.Cells(i + 4, 1) = maStr(0)
Sh2.Cells(i + 4, 2) = maStr(1)
Sh2.Cells(i + 4, 3) = maStr(2)
Next i
Set monDico = Nothing
'on prépare les formules
Lico = Worksheets("FM Run").Range("B2:B" & DerLi).Address(, , xlR1C1)
Ref = Worksheets("FM Run").Range("C2:C" & DerLi).Address(, , xlR1C1)
Design = Worksheets("FM Run").Range("D2:D" & DerLi).Address(, , xlR1C1)
SS = Worksheets("FM Run").Range("F2:F" & DerLi).Address(, , xlR1C1)
Total_2008 = Worksheets("FM Run").Range("AC2:AC" & DerLi).Address(, , xlR1C1)
DerLiReport = Sh2.Columns(1).Find("*", , , , , xlPrevious).Row
'insertion formules SOMMEPROD & SOMME
Sh2.Range(Cells(4, 4), Cells(DerLiReport, 36)).FormulaR1C1 = _
"=SUMPRODUCT(('FM Run'!" & Lico & "=RC1)*('FM Run'!" & Ref & "=RC2)*('FM Run'!" & _
Design & "=RC3)*('FM Run'!" & SS & "=R3C)*'FM Run'!" & Total_2008 & ")"
Sh2.Range(Cells(4, 13), Cells(DerLiReport, 13)).FormulaR1C1 = "=SUM(RC[-9]:RC[-1])"
Sh2.Range(Cells(4, 16), Cells(DerLiReport, 16)).FormulaR1C1 = "=SUM(RC[-2]:RC[-1])"
Sh2.Range(Cells(4, 34), Cells(DerLiReport, 34)).FormulaR1C1 = "=SUM(RC[-17]:RC[-1])"
Sh2.Range(Cells(4, 37), Cells(DerLiReport, 37)).FormulaR1C1 = "=SUM(RC[-2]:RC[-1])"
Sh2.Range(Cells(4, 38), Cells(DerLiReport, 38)).FormulaR1C1 = "=SUM(RC[-1],RC[-4],RC[-22],RC[-25])"
Columns("A:AL").AutoFit
'Si tu veux les valeurs, plutôt que les formules
' enlève l'apostrophe devant les 3 lignes qui suivent
'With SH2.Range(Cells(4, 4), Cells(DerLiReport, 38))
' .Copy: .PasteSpecial Paste:=xlPasteValues
'End With
Application.Calculation = Calc
Application.ScreenUpdating = True
End Sub |
