MACRO - Mettre à jour un tableau selon différentes contraintes (avancé)
Cher forum
J'ai un projet de macro VBA sur lequel je bloque...
J'ai un tableau à mettre à jour (=T2)
par rapport à un autre tableau récent (T1) qui lui ressort tous les jours, d'où le besoin d'une automatisation
Il y a plusieurs contraintes à respecter. Ce n'est sans doute pas si compliqué pour certains d'entre vous mais personnellement je n'ai pas le niveau
Je vais essayer d'être le plus clair possible :
Sur ces tableaux, nous avons différents produits que l'on différence en fonction de la colonne "Code référence".
À l'issue de l'exécution de la macro, j'aimerais obtenir un résultat selon les contraintes suivantes :
- Sur le tableau à mettre à jour =T2, supprimer les lignes coloriées en verte SAUF si elles sont dans l'onglet n°1 (sur le T1) --> Si c'est le cas, mettre le nom du produit en gras et laisser la ligne en vert (sur le T2 toujours);
- Les lignes coloriées en violettes (RGB 204 192 218) doivent redevenir blanches;
- Les lignes rouges doivent rester rouges même si le produit est dans l'onglet n°1;
- Bien évidemment copier les produits qui n'étaient pas sur le tableau avant (les nouveaux)
- D'une manière générale pour tous les produits qui sont présents sur les deux tableaux à la fois, peu importe la couleur, vérifier que la date du T2 soit bien la même que sur le T1, sinon mettre à jour en fonction du T1,
-Dernière contrainte : toujours garder le commentaire et SURTOUT le valideur qui était déjà indiqué sur le T2 (si un autre valideur apparait sur le T1, ne pas le prendre en compte mais quand même mettre la date à jour).
Dans le fichier joint, le résultat final serait donc idéalement :
Je vous remercie mille fois
Bien cordialement
Bonjour,
un essai :
Sub Maj_Tab()
Dim W1 As Worksheet, W2 As Worksheet, DL As Long, T, Dico As Object, Plage As Range, TT
Set W1 = Worksheets("Nouvelles données") 'adapter le nom
Set W2 = Worksheets("Tableau à mette à jour") 'adapter le nom
Set Dico = CreateObject("Scripting.Dictionary")
DL = W1.Range("B" & Rows.Count).End(xlUp).Row
T = W1.Range("B4:F" & DL)
For i = LBound(T, 1) To UBound(T, 1)
Dico(T(i, 2)) = T(i, 1) & "|" & T(i, 3) & "|" & T(i, 4)
Next
With W2
DL = W2.Range("B" & Rows.Count).End(xlUp).Row
For i = DL To 2 Step -1
If Dico.Exists(.Cells(i, 3).Value) Then
TT = Split(Dico(Cells(i, 3).Value), "|")
.Cells(i, 2).Value = CDate(TT(0))
If .Cells(i, 3).Interior.ColorIndex = 43 Then .Cells(i, 4).Font.Bold = True
If .Cells(i, 3).Interior.ColorIndex = 15 Then .Cells(i, 2).Resize(1, 4).Interior.ColorIndex = vbnone
.Cells(i, 2).NumberFormat = "dd/mm"
Dico.Remove (.Cells(i, 3).Value)
Else
If .Cells(i, 3).Interior.ColorIndex = 43 Then .Rows(i).Delete
End If
Next
DL = W2.Range("B" & Rows.Count).End(xlUp).Row
For Each clé In Dico.keys
DL = DL + 1
TT = Split(Dico(clé), "|")
.Cells(DL, 2).Value = TT(0)
.Cells(DL, 3).Value = clé
.Cells(DL, 4).Value = TT(1)
.Cells(DL, 6).Value = TT(2)
Next
End With
End Suba tester...
A+
Bonsoir AlgoPlus
Alors là je suis encore retourné
Le seul point d'attention serait de comprendre pourquoi le valideur Jean Claude ne s'est pas ajouté sur le produit LG08 alors qu'il était dans le T1. Merci encore ! Je compte bien essayer de comprendre ce code entièrement !
Le valideur n'est pas rajouté pour respecter :
Dernière contrainte : toujours garder le commentaire et SURTOUT le valideur qui était déjà indiqué sur le T2 (si un autre valideur apparait sur le T1, ne pas le prendre en compte mais quand même mettre la date à jour).
Pour rajouter le "valideur", apporter cette modification :
.../...
If .Cells(i, 3).Interior.ColorIndex = 15 Then .Cells(i, 2).Resize(1, 4).Interior.ColorIndex = vbnone
If .Cells(i, 6).Value ="" then .Cells(i, 6).Value = TT(2) ' ligne à rajouter
.Cells(i, 2).NumberFormat = "dd/mm"
.../...N'hésitez pas à demander des explications sur les points obscurs..
Bonjour à tous,
AlgoPlus, merci encore pour ta solution. Je suis actuellement en train de comprendre comment fonctionne le dictionnaire et le reste du code. En voulant répliquer cet exercice, j'ai l'erreur suivante : "Erreur d'exécution 429 - Un composant ActiveX ne peut pas créer d'objet"
Sur la ligne de code :
Set Dico=CreateObject("Scripting.Dictionnay")En cherchant un peu, c'est possible que ce soit à cause d'une références (dans outils) décochée ?
Tel que le code est écrit, il n'y a pas de référence particulière à cocher.
Si le code a fonctionné une première fois, et qu'il ne fonctionne plus après "réplication" (sur le même classeur ? un autre ? un autre ordi ? une autre version d'excel ?....), voir les différences de référence entre les deux essais....