Discussion :

[loenia]

Bonjour à tous,

Je sais bien que c'est le 2000ème message sur ce sujet, mais je rame depuis plusieurs jours maintenant, donc je me résigne à vous embêter...

J'ai deux feuilles dans un classeur Excel. J'ai une macro qui récupère des données dans la première feuille selon certaines conditions et qui met ces données dans la deuxième feuille.

Maintenant j'aimerai rajouter des conditions pour comparer les données dans ma feuille 2 avec celles que je vais y mettre : si l'id est le même et qu'il a les mêmes valeurs, je ne fais rien ; si l'id est le même et qu'il a des valeurs différentes, je change les valeurs concernées et je colore la case ; si l'id est différent, je crée une nouvelle ligne et je la colore en entier.

J'ai essayé plusieurs choses mais je rame sévère. Je pense que je dois faire un tableau dynamique dans lequel stocker mes valeurs. Ou utiliser un objet dictionnary.

La vérité c'est que j'en ai marre, et je suis dépitée de mes essais infructueux.
Donc si vous aviez qques pistes pour moi, merci d'avance.

Je vous mets la macro (qui fonctionne) à optimiser :

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
 
Option Explicit
'
' Macro pour mettre à jour le tableau des commandes en cours
'
Sub maj_tableau()
 
'Déclaration des variables
Dim SC As Object                                'déclare la variable SC (onglet Suivi des Commandes)
Dim MAJ As Object                               'déclare la variable MAJ (onglet Mise à Jour Commandes)
 
Dim ligneFin As Integer                         'déclare la variable ligne de fin
Dim I As Integer                                'déclare la variable I (incrément)
Dim J As Integer                                'déclare la variable J (incrément)
Dim K As Integer                                'déclare la variable K (incrément)
Dim L As Integer                                'déclare la variable L (incrément)
 
Dim TSC As Variant 'déclare la variable TSC (Tableau Suivi des Commandes)
Dim T() As Variant 'déclare la variable T
 
'Début de la macro
Application.ScreenUpdating = False
 
'Définition des onglets
Set SC = Sheets("Suivi des Commandes")          'définit l'onglet SC
Set MAJ = Sheets("Mise à Jour Commandes")       'définit l'onglet MAJ
 
ligneFin = SC.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée de la colonne 1 (=A) de l'onglet SC
TSC = SC.Range("A5:X" & ligneFin)               'définit le tableau de cellules TSC
 
'boucle 1 : sur toutes les lignes du tableau TSC
For I = 1 To UBound(TSC)
    'condition : si la cellule en colonne 23 (=W) de la ligne est égale à AUJOURDHUI ou VIDE
    If (TSC(I, 23) = Date Or TSC(I, 23) = "") And TSC(I, 20) = "" And TSC(I, 21) = "" Then
        ReDim Preserve T(6, J)                  'redimensionne le tableau T
        T(0, J) = TSC(I, 1)                     'récupère l'[Identifiant de la commande] dans la première ligne  (ligne 0)
        T(1, J) = TSC(I, 3)                     'récupère la [Désignation] dans la deuxième ligne  (ligne 1)
        T(2, J) = TSC(I, 6)                     'récupère la [Quantité commandée] dans la troisième ligne  (ligne 2)
        T(3, J) = TSC(I, 16)                    'récupère la [Date demandée finale] dans la quatrième ligne  (ligne 3)
        T(4, J) = TSC(I, 17)                    'récupère la [Date confirmée finale] dans la cinquième ligne  (ligne 4)
        T(5, J) = TSC(I, 23)                    'récupère la [Date réelle de livraison] dans la sixième ligne  (ligne 5)
        T(6, J) = TSC(I, 24)                    'récupère la [Quantité réelle livrée] dans la sixième ligne  (ligne 6)
        J = J + 1
    End If
Next I
 
'boucle 2 : sur toutes les colonnes du tableau T
For K = 0 To UBound(T, 2)
    'boucle 3 : sur les 6 lignes du tableau T
    For L = 0 To 6
        MAJ.Cells(K + 1, 1).Offset(2, L) = T(L, K) 'renvoie en transposant les données du tableau T dans l'onglet MAJ
    Next L
Next K
 
Application.ScreenUpdating = True
 
End Sub

Si vous avez des remarques pour améliorer ce morceau qui fonctionne bien, n'hésitez pas non plus!

[Marc-L]

Bonjour,

pour éviter peut-être l'usine à gaz, je commencerais par un filtre avancé sur place à l'aide d'un critère calculé pour les nouveaux IDs.
Les lignes cachées étant donc les IDs déjà présents, les parcourir afin de les mettre à jour. Puis copie des lignes affichées …

La fonction de feuilles de calcul EQUIV (Match en VBA) permet de vérifier si un id existe ou pas ou encore la méthode Find …
Tout dépendra en fait de la structure des données.


_____________________________________________________________________________________________________
Je suis Charlie - Je suis Bardo

[loenia]

Alors je suis en train de lire le tuto sur les filtres avancés, mais à part si je n'ai pas compris le principe, je ne suis pas sûre que ça convienne.
L'objectif de ma macro est que tout se fasse seul sans intervention des utilisateurs à par un clic sur un bouton.

Je ne vois pas comment intégrer un filtre avancé à tout ça...

Je n'avais pas été jusqu'au point XII...

Après avoir tout bien lu (jusqu'au bout), je ne comprends toujours pas comment faire...

[Marc-L]

C'était une indication car, comme déjà indiqué, tout dépendra de la structure des données et, sans la connaître, …

En attendant la fin de journée où je devrais être disponible, si personne d'autre ne vient en aide,
n'hésite pas à donner des détails où à joindre un classeur exemple .xlsx (sans code) et en expliquant bien le but …

[loenia]

Alors pour expliquer au mieux ce que j’essaie de faire :
J’ai un fichier avec deux feuilles.

La première de mes feuilles est un récapitulatif des commandes passées depuis le début de l’année par l’entreprise. Je n’en suis pas l’utilisatrice principale, il faut donc qu’elle reste telle quelle.

La deuxième correspond au tableau que je veux créer. Pour faciliter le travail du planning de l’entreprise, qui suit les évolutions des commandes, j’ai fait une macro qui récupère uniquement les données utiles au planning. C’est la macro que j’ai mis dans mon premier post. On appuie sur le bouton de mise à jour et le tableau se remplit des données concernant uniquement les livraisons du jour ou non effectuées.

Elle fonctionne mais peut-être beaucoup améliorée.

A l’usage, je me suis d’abord rendue compte que quand je fais ma mise à jour, si j’ai moins de lignes copiées que la fois précédentes, les lignes inutiles ne sont pas effacées. Je pourrai utiliser une fonction du type clear content ou qqch comme ça.
Mais je voudrais aussi pouvoir marquer les différences entre avant et après la mise à jour. Et la méthode de copie de mes données ne marche plus (en tous cas je ne sais pas faire ça).

Je voudrais si les nouvelles données sont :
- Identiques aux anciennes, ne rien faire.
- Partiellement différentes, mettre un fond coloré aux nouvelles données.
- Totalement différentes, copier la ligne entière avec un fond coloré.

Dans l’idéal, je voudrais aussi que mes lignes se trient par date de livraison ou si elle est vide, par date confirmée finale, ou si c’est vide, par date demandée finale.
A la base le fichier Suivi des commandes n’avait aucun identifiant pour chacune de ses lignes. J’ai don fait une macro qui en ajoute un dans la première colonne.

C’est cet identifiant qui devrait me permettre la comparaison.

Ici je vous mets le code de ma macro de mise à jour des identifiants

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
 
 
Option Explicit
 
'Déclarations des variables constantes
Const coId = "A"                'Choix de la colonne où mettre l'ID
Const coFournisseur = "B"       'Choix de la colonne sur laquelle se baser pour savoir si la ligne est vide
Const ligneDeb = 5              'Choix de la ligne de début des IDs
 
'
' Macro pour incrémenter l'identifiant à chaque nouvelle commande
'
Sub maj_ID()
 
'Déclarations des variables
Dim ligne As Long               'Ligne sur laquelle on travaille
Dim ligneFin As Long            'Dernière ligne du tableau
Dim idMax As Long               'Dernier ID utilisé
 
'Début de la macro
Application.ScreenUpdating = False
 
With ActiveSheet
  ligneFin = .Range(coFournisseur & Rows.Count).End(xlUp).Row
  idMax = Application.WorksheetFunction.Max(Columns(coId))
  For ligne = ligneDeb To ligneFin
    If .Range(coId & ligne).Value = "" Then
      .Range(coId & ligne).Value = idMax + 1
      .Range(coId & ligne).NumberFormat = "00000"
      idMax = idMax + 1
    End If
  Next ligne
End With
 
Application.ScreenUpdating = True
 
End Sub

Ici je vous remets le code de ma macro qui fonctionne mais qui est incomplète.

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
 
Option Explicit
'
' Macro pour mettre à jour le tableau des commandes en cours
'
Sub maj_tableau()
 
'Déclaration des variables
Dim SC As Object                                'déclare la variable SC (onglet Suivi des Commandes)
Dim MAJ As Object                               'déclare la variable MAJ (onglet Mise à Jour Commandes)
 
Dim ligneFin As Integer                         'déclare la variable ligne de fin
Dim I As Integer                                'déclare la variable I (incrément)
Dim J As Integer                                'déclare la variable J (incrément)
Dim K As Integer                                'déclare la variable K (incrément)
Dim L As Integer                                'déclare la variable L (incrément)
 
Dim TSC As Variant 'déclare la variable TSC (Tableau Suivi des Commandes)
Dim T() As Variant 'déclare la variable T
 
'Début de la macro
Application.ScreenUpdating = False
 
'Définition des onglets
Set SC = Sheets("Suivi des Commandes")          'définit l'onglet SC
Set MAJ = Sheets("Mise à Jour Commandes")       'définit l'onglet MAJ
 
ligneFin = SC.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée de la colonne 1 (=A) de l'onglet SC
TSC = SC.Range("A5:X" & ligneFin)               'définit le tableau de cellules TSC
 
'boucle 1 : sur toutes les lignes du tableau TSC
For I = 1 To UBound(TSC)
    'condition : si la cellule en colonne 23 (=W) de la ligne est égale à AUJOURDHUI ou VIDE et qu'il n'y a ni pb d'allocation, ni annulation
    If (TSC(I, 23) = Date Or TSC(I, 23) = "") And TSC(I, 20) = "" And TSC(I, 21) = "" Then
        ReDim Preserve T(6, J)                  'redimensionne le tableau T
        T(0, J) = TSC(I, 1)                     'récupère l'[Identifiant de la commande] dans la première ligne  (ligne 0)
        T(1, J) = TSC(I, 3)                     'récupère la [Désignation] dans la deuxième ligne  (ligne 1)
        T(2, J) = TSC(I, 6)                     'récupère la [Quantité commandée] dans la troisième ligne  (ligne 2)
        T(3, J) = TSC(I, 16)                    'récupère la [Date demandée finale] dans la quatrième ligne  (ligne 3)
        T(4, J) = TSC(I, 17)                    'récupère la [Date confirmée finale] dans la cinquième ligne  (ligne 4)
        T(5, J) = TSC(I, 23)                    'récupère la [Date réelle de livraison] dans la sixième ligne  (ligne 5)
        T(6, J) = TSC(I, 24)                    'récupère la [Quantité réelle livrée] dans la sixième ligne  (ligne 6)
        J = J + 1
    End If
Next I
 
'boucle 2 : sur toutes les colonnes du tableau T
For K = 0 To UBound(T, 2)
    'boucle 3 : sur les 6 lignes du tableau T
    For L = 0 To 6
        MAJ.Cells(K + 1, 1).Offset(2, L) = T(L, K) 'renvoie en transposant les données du tableau T dans l'onglet MAJ
    Next L
Next K
 
Application.ScreenUpdating = True
 
End Sub

Merci d’avance à tous ceux qui passeront un peu de temps sur mes problèmes.

[Marc-L]

Basé sur le classeur joint en utilisant le filtre déjà présent :

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
Sub Demo1()
    With Feuil2.[A2].CurrentRegion.Rows
        Application.ScreenUpdating = False
                                D& = .Count + 2
        If .Count > 1 Then
            With .Item(2).Resize(.Count - 1)
                 .Interior.ColorIndex = xlNone
                                  AD$ = .Columns(1).Address(, , , True)
            End With
        End If
    End With
 
    With Feuil1
        If .FilterMode Then .ShowAllData
        With .[A4].CurrentRegion:  L& = .Rows.Count:  C& = .Columns.Count:  End With
 
        If AD > "" Then
            .Cells(5, C + 2).Resize(L - 4).Formula = "=MATCH(A5," & AD & ",0)+2"
                                               COL = [{1,3,6,8,17,22,23}]
            For R& = 5 To L
                             V = .Cells(R, C + 2).Value
                If IsNumeric(V) Then
                    For N& = 2 To UBound(COL)
                           W = .Cells(R, COL(N)).Value
                        With Feuil2.Cells(V, N)
                            If .Value <> W Then .Value = W: .Interior.ColorIndex = 40
                        End With
                    Next
                End If
            Next
 
            With .[B4].Resize(L - 3, C + 1):  .AutoFilter:  .AutoFilter C + 1, "#N/A":  End With
        End If
 
        With .Rows(4).Resize(L - 3, C).Offset(1).Columns
            Union(.Item(1), .Item(3), .Item(6), .Item(8), .Item(17), .Item("V:W")).Copy Feuil2.Cells(D, 1)
        End With
 
        If .FilterMode Then .ShowAllData
        .Cells(5, C + 2).CurrentRegion.Clear
    End With
 
    With Feuil2.Cells(1).CurrentRegion.Rows
        If .Count >= D Then .Item(D & ":" & .Count).Interior.ColorIndex = 36
    End With
End Sub

_____________________________________________________________________________________________________

Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion …

[loenia]

Donc j'ai tout repris, pas du tout comme on m'a répondu, pcq j'y comprends vraiment rien.
Mais tout fonctionne comme je voulais, sauf ma condition :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
If (Sheets(FS).Cells(liFS, coDL).Value = Date Or Sheets(FS).Cells(liFS, coDL).Value = "") And Sheets(FS).Cells(liFS, coAA).Value = "" And Sheets(FS).Cells(liFS, coPL).Value = "" Then

Je remets ma nouvelle macro complète, si qqun a une idée de pourquoi ça ne veut pas marcher :

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
 
Option Explicit
Option Base 1
 
Public Const FS = "Suivi des commandes"
Const lidebFS = 5
Const coId = "A"
Const coAA = "T"                                'déclare comme constante la colonne W pour la colonne des Annulations AMCOR
Const coPL = "U"                                'déclare comme constante la colonne W pour la colonne de Pas de livraison
Const coDL = "W"                                'déclare comme constante la colonne W pour la colonne de Date de livraison réelle
 
Public Const FM = "Mise à Jour Commandes"
Public Const lidebFM = 3
Public Const cofinFM = 7
Const coulFM = 23
 
Public Sub MAJCommandes()
 
Dim liFS As Long, lifinFS As Long
Dim id As Long
Dim liFM As Long, lifinFM As Long, coFM As Long
Dim objFM As Object, liobjFM As Long
Dim TcoFS()
 
'Début de la macro
Application.ScreenUpdating = False
 
'liste des n° de colonnes dans FS qui sont dans FM
TcoFS = Array(1, 3, 6, 16, 17, 23, 24)
 
' dernière ligne de FM
lifinFM = Sheets(FM).Cells(Rows.Count, 1).End(xlUp).Row
 
'On parcourt le tableau FM
For liFM = lidebFM To lifinFM
    'On enlève le fond coloré
    Rows(liFM).Interior.ColorIndex = xlNone
    'On enlève la ligne si date livraison>AUJOURDHUI
    If Sheets(FM).Cells(liFM, coDL).Value > Date Then
        Rows(liFM).Delete Shift:=xlUp
    End If
Next liFM
 
' dernière ligne de FS
lifinFS = Sheets(FS).Cells(Rows.Count, 1).End(xlUp).Row
 
'On parcourt toutes les lignes de FS
For liFS = lidebFS To lifinFS
 
    ' On donne la valeur de l'identificateur de cette ligne à id
    id = Sheets(FS).Cells(liFS, coId).Value
    ' recherche de id dans colonne coId de FM
    Set objFM = Sheets(FM).Columns(coId).Find(id, , , xlWhole)
 
    If (Sheets(FS).Cells(liFS, coDL).Value = Date Or Sheets(FS).Cells(liFS, coDL).Value = "") And Sheets(FS).Cells(liFS, coAA).Value = "" And Sheets(FS).Cells(liFS, coPL).Value = "" Then
        ' si id non trouvé
        If objFM Is Nothing Then
            'Do While (Cells(fin + 1, 1) <> "" And Cells(fin + 1, 1) = Cells(fin, 1))
 
                'copie de cet id dans FM
                lifinFM = Sheets(FM).Cells(Rows.Count, 1).End(xlUp).Row
                For coFM = 1 To cofinFM
                    Sheets(FS).Cells(liFS, TcoFS(coFM)).Copy
                    Sheets(FM).Cells(lifinFM + 1, coFM).PasteSpecial Paste:=xlPasteValues
                    Sheets(FM).Cells(lifinFM + 1, coFM).Interior.ColorIndex = coulFM
                Next coFM
 
        ' si id trouve modification+couleur éventuelle de cet id dans FM
        Else
            ' ligne de id dans FM
            liobjFM = objFM.Row
            ' boucle sur les colonnes de FM
                For coFM = 1 To cofinFM
                  ' si données differentes on colorie la cellule
                  If Sheets(FS).Cells(liFS, TcoFS(coFM)).Value <> Sheets(FM).Cells(liobjFM, coFM).Value Then
                    Sheets(FM).Cells(liobjFM, coFM).Interior.ColorIndex = coulFM
                  End If
                  ' on copie la cellule - dans tous les cas
                  Sheets(FS).Cells(liFS, TcoFS(coFM)).Copy
                  Sheets(FM).Cells(liobjFM, coFM).PasteSpecial Paste:=xlPasteValues
                Next coFM
         End If
    End If
Next liFS
 
Application.ScreenUpdating = True
End Sub

[Marc-L]

Mon code du post #6 fonctionne pourtant bien de mon côté avec le classeur joint dans le post #5 !

L'as-tu au moins testé avec ce classeur ? Quel est donc le souci ?

[loenia]

Vuq ue je ne le comprenais pas du tout et que je voulais ajouter des choses à ma demande initiale, non je ne l'utilise pas.
Je suis désolée, mais sans aucun commentaire, je suis incapable de reprendre ce code et y ajouter des choses.
Mais j'avance sur le mien, même s'il a beaucoup plus de lignes.