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
| Sub top5_evolution()
For t = 1 To 2
For p = 1 To 3
For w = 1 To 4
If w > 1 Then
Range("K4").Value = "Product/Period"
Dim ref As Integer
ref = 26023 + w - 2 + 5 * (p - 1)
Range("K5").Formula = "=CONCATENATE(LEFT(D" & ref & ",2*" & w & "-2),""?? *"")"
Range("A3:I26014").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
Range("K4:K5"), Unique:=False
Range("K4").Value = ""
Range("K5").Value = ""
Cells(26025 + w - 2 + 5 * (p - 1), 4).CurrentRegion.Select
selection.Offset(w - 1, 0).Select
selection.Clear
End If
Set Table = Range("A1").CurrentRegion
Table.Offset(3, 0).Resize(Table.Rows.Count - 3, Table.Columns.Count - 0).Copy
Cells(26025 + w - 2 + 5 * (p - 1) + 15 * (t - 1), 4).PasteSpecial
selection.Replace What:="", Replacement:="0"
Dim lignes As Integer
lignes = selection.Rows.Count
selection.End(xlToRight).Select
selection.Offset(0, 1).Resize(lignes, 1).Select
selection.FormulaR1C1 = "=RC[-3]-RC[-4]"
Dim chiffres As Single
chiffres = 0
Set tablecopy = Cells(26025 + w - 2 + 5 * (p - 1) + 15 * (t - 1), 4).CurrentRegion
Cells(26025 + w - 2 + 5 * (p - 1) + 15 * (t - 1), 13).Activate
Dim signe As String
If t = 1 Then
signe = ">"
Else
signe = "<"
End If
For i = 1 To tablecopy.Rows.Count
If ActiveCell & signe & chiffres Then
chiffres = ActiveCell.Value
Cells(26024 + w - 2 + 5 * (p - 1) + 15 * (t - 1), 5).Value = chiffres
ActiveCell.Offset(0, -9).Copy
Cells(26024 + w - 2 + 5 * (p - 1) + 15 * (t - 1), 4).PasteSpecial
ActiveCell.Offset(i, 9).Select
End If
ActiveCell.Offset(1, 0).Select
Next i
Next w
Cells(26028 + 5 * (p - 1) + 15 * (t - 1), 4).CurrentRegion.Select
selection.Offset(4, 0).Resize(selection.Rows.Count - 4, selection.Columns.Count).Select
selection.Clear
Next p
Next t
End Sub |
Partager