Discussion :

[BosonDeH]

Bonjour cher Forum,
Voici un fichier excel qui reprend les valeurs (en vecteur) de chaque produit et ces valeurs sont mises à jour chaque jour et j’ai déjà une macro pour l’update.

J’aimerai une macro qui
-Avant l’update copie colle les valeurs sur une feuille vierge (valeur en t-1)
-Après l’update compare les valeurs en t-1 et valeurs en t
Si l’écart est supérieur à 50% en valeur absolue, on conserve les données de la date précédente pour le produit concerné (toute la ligne).
PS : le produit sont ajoutés chaque jour et ont des structures de naming différente.

Merci d’avance. Test.xlsx

[ARTURO83]

Bonjour,

Essayez ceci:

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
Sub Copie() 'A faire avant la mise à jour
    Dim f1 As Worksheet, f2 As Worksheet
    Dim DerPos As String
    Application.ScreenUpdating = False
    Set f1 = Sheets("Feuil1")
    Set f2 = Sheets("Feuil2")
    f2.Cells.ClearContents
    DerPos = f1.Cells.SpecialCells(xlCellTypeLastCell).Address
    f2.Range("A1:" & DerPos).Value = f1.Range("A1:" & DerPos).Value
    Set f1 = Nothing
    Set f2 = Nothing
End Sub
 
Sub Compare() ' A faire après la mise à jour
    Dim f1 As Worksheet, f2 As Worksheet
    Dim DerLig As Long, DerCol As Long, i As Long, j As Long
    Application.ScreenUpdating = False
    Set f1 = Sheets("Feuil1")
    Set f2 = Sheets("Feuil2")
    DerLig = f1.Range("A" & Rows.Count).End(xlUp).Row
    DerCol = f1.Range("A1").End(xlToRight).Column
    For i = DerLig To 2 Step -1
        For j = 3 To DerCol
            If Abs((f1.Cells(i, j) - f2.Cells(i, j)) / f2.Cells(i, j)) > 0.5 Then
                f1.Rows(i).Delete
                Exit For
            End If
        Next j
    Next i
    Set f1 = Nothing
    Set f2 = Nothing
End Sub

Pièce jointe 608657

Cdlt