Sujet Précédent Sujet Suivant

Pb de macro pour comparer les données de deux feuilles

Résolu/Fermé
mstecluque Messages postés 73 Date d'inscription mardi 9 juin 2015 Statut Membre Dernière intervention 28 juillet 2015 - 15 juin 2015 à 15:13
mstecluque Messages postés 73 Date d'inscription mardi 9 juin 2015 Statut Membre Dernière intervention 28 juillet 2015 - 1 juil. 2015 à 09:45
Bonjour à tous,

Une nouvelle question : 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. En gros la seule chose que j'ai réussi, c'est colorer mes cellules... Je pense que je dois faire un tableau dynamique dans lequel stocker mes valeurs.

Si vous aviez qques pistes pour moi, merci d'avance.

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

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:W" & 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 22 (=V) de la ligne est égale à AUJOURDHUI ou VIDE
    If TSC(I, 22) = Date Or TSC(I, 22) = "" 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, 22)                    'récupère la [Date réelle de livraison] dans la sixième ligne  (ligne 5)
        T(6, J) = TSC(I, 23)                    '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


A voir également:

9 réponses

Réponse 1 / 9
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
15 juin 2015 à 15:29
Bonjour

As tu tenté la comparaison avec on objet dictionary ?

transféré dans forum Programmation/vba
0
mstecluque Messages postés 73 Date d'inscription mardi 9 juin 2015 Statut Membre Dernière intervention 28 juillet 2015
15 juin 2015 à 15:45
Non je n'ai pas essayé ça. Je regarde ce que c'est.
Et merci pour le transfert
0
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
15 juin 2015 à 16:03
peut-^tre pas par dictionary car il me semble que tu compare ligne à ligne ?

pour voir,fais moi une maquette simplifiée avec 2 tableaux(1 colonne id, 1 colonne valeurs) en précisant bien quel tableau subirat des changements (couleur, valeur, saut de ligne...)
0
mstecluque Messages postés 73 Date d'inscription mardi 9 juin 2015 Statut Membre Dernière intervention 28 juillet 2015
15 juin 2015 à 16:31
https://www.cjoint.com/c/EFpoE318bIC

J'ai supprimé toutes les valeurs inutiles. Mais j'ai laissé le nécessaire pour les macros.
Merci d'avance
0
Réponse 2 / 9
mstecluque Messages postés 73 Date d'inscription mardi 9 juin 2015 Statut Membre Dernière intervention 28 juillet 2015
16 juin 2015 à 13:10
Je suis toujours dans la même situation.
Je me suis penchée sur les filtres avancés, les dictionnary.
Je rame toujours!
0
Réponse 3 / 9
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
16 juin 2015 à 14:05
Sauf erreur de ma part, le classeur joint rest le classeur une fois la mise à jour effectuée: avec je ne peux rien faire ou perdre du temps à mettre des données bidon...
0
mstecluque Messages postés 73 Date d'inscription mardi 9 juin 2015 Statut Membre Dernière intervention 28 juillet 2015
16 juin 2015 à 14:24
C'est pas faux...
https://www.cjoint.com/c/EFqmxNbin2C

C'est le tableau de la deuxième feuille qui subit les modifications
0
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
16 juin 2015 à 15:26
Ok, merci je regarde le tout tout à l'heure ou demain après-midi
0
mstecluque Messages postés 73 Date d'inscription mardi 9 juin 2015 Statut Membre Dernière intervention 28 juillet 2015
16 juin 2015 à 16:04
merci beaucoup
0
Réponse 4 / 9
ccm81 Messages postés 10851 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 16 avril 2024 2 404
16 juin 2015 à 17:24
Bonjour à tous les deux

A tester en attendant la solution de Michel que je salue au passage
http://www.cjoint.com/c/EFqpxA61P0g

Le code est dans le Module 1

Cdlmnt
0
mstecluque Messages postés 73 Date d'inscription mardi 9 juin 2015 Statut Membre Dernière intervention 28 juillet 2015
17 juin 2015 à 08:45
Merci. A part la couleur que j'ai du changer pcq elle ne s'affichait pas, tout marche.
Maintenant il faut juste que je comprenne bien le code.
0
mstecluque Messages postés 73 Date d'inscription mardi 9 juin 2015 Statut Membre Dernière intervention 28 juillet 2015
17 juin 2015 à 08:50
bon en fait ça marche pas vraiment, mais c'est pas grave, c'est déjà un bon début avec lequel je vais pouvoir continuer.
Merci beaucoup
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 9
mstecluque Messages postés 73 Date d'inscription mardi 9 juin 2015 Statut Membre Dernière intervention 28 juillet 2015
19 juin 2015 à 09:23
Bonjour,

Alors j'ai essayé d'avancer ces derniers jours en mixant mon code avec celui de ccm81. Un échec. Du coup depuis ce matin, je fais le contraire, je rajoute à son code ce qui y manque.
Bien évidemment ça ne marche pas.
J'ai voulu ajouter unboucle que chacune des lignes de mon tableau de mise à jour des commandes, pour que les lignes avec des dates de livraison antérieures à aujourd'hui soient effacées, et que pour chaque ligne créée précédemment, on enlève le fond coloré ==> ECHEC

Et surtout je voudrais rajouter mes conditions de copie des lignes. Mais encore une fois, j'ai l'impression de bien faire alors que pas du tout...

Je vous mets le code où j'en suis actuellement.
Si vous avez un peu de temps pour me dire pourquoi ça ne fonctionne pas, merci d'avance ! 


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, 8, 17, 22, 23)

'On vide les valeurs inutiles du tableau MAJ et on enlève le fond coloré
For liFM = lidebFM To lifinFM
    'On enlève le fond coloré
    Range(liFM).Select
    Selection.Interior.ColorIndex = xlNone
    'On enlève la ligne si date livraison<AUJOURDHUI
    If Sheets(FM).Cells(liFM, coDL).Value < Date Then
        Range(liFM).Select
        Selection.Delete Shift:=xlUp
    End If


' 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
      If objFM Is Nothing Then
        ' si id non trouvé,
        
            '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
    
      Else
        ' si id trouve modification+couleur éventuelle de cet id dans FM
        ' 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
Next liFM
Application.ScreenUpdating = True
End Sub
0
Réponse 6 / 9
ccm81 Messages postés 10851 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 16 avril 2024 2 404
Modifié par ccm81 le 19/06/2015 à 10:32
Bonjour

Trois remarques

1. La colonne de date de livraison réelle est V et non W (liste des constantes) à moins que tu n'aies modifié la structure de ta feuille

2. Le bloc 
'On vide les valeurs inutiles du tableau MAJ et on enlève le fond coloré
For liFM = lidebFM To lifinFM
    'On enlève le fond coloré
    Range(liFM).Select
    Selection.Interior.ColorIndex = xlNone
    'On enlève la ligne si date livraison<AUJOURDHUI
    If Sheets(FM).Cells(liFM, coDL).Value < Date Then
        Range(liFM).Select
        Selection.Delete Shift:=xlUp
    End If


est apparemment indépendant de la suite (il n'y a pas d'autres occurrences de liFM dans la suite) donc, le terminer avec Next liFM après le End if (et supprimer Next liFM après le Next liFS), ça fera plus propre

'On vide les valeurs inutiles du tableau MAJ et on enlève le fond coloré 
For liFM = lidebFM To lifinFM
    'On enlève le fond coloré
    Range(liFM).Select
    Selection.Interior.ColorIndex = xlNone
    'On enlève la ligne si date livraison<AUJOURDHUI
    If Sheets(FM).Cells(liFM, coDL).Value < Date Then
        Range(liFM).Select
        Selection.Delete Shift:=xlUp
    End If
Next liFM


3. En début de boucle
For liFM = lidebFM To lifinFM
liFM n'est pas connu donc vaut 0

> En simplifiant un peu, ça donne 

' dernière ligne de la feuille FM
lifinFM = Sheets(FM).Range(coId & Rows.Count).End(xlUp).Row
'On vide les valeurs inutiles du tableau MAJ et on enlève le fond coloré
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
    End If
Next liFM

Il y en a certainement d'autres

Cdlmnt
0
mstecluque Messages postés 73 Date d'inscription mardi 9 juin 2015 Statut Membre Dernière intervention 28 juillet 2015
19 juin 2015 à 11:47
Alors pour le premier point, c'est bien W, j'ai du ajouter une colonne pour une condition.
Par contre j'avais oublié de modifier mes numéros de colonnes dans TcoFS.

Pour le deuxième, je me suis rendue compte direct après mon post de mon oubli de déclaration.
Au tout début de mes essais j'avais bien rendu ce bloc indépendant, mais vu mon nombre d'échecs, j'ai essayé différemment.

Donc j'ai tout corrigé, comme il faut, et ça marche pour cette première partie de code.

La seule chose qui ne marche pas, c'est toujours ma condition : 
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


J'ai modifié d'autres choses, donc je remets ma macro complète, si qqun a une idée de pourquoi ça ne veut pas marcher : 

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

0
Réponse 7 / 9
mstecluque Messages postés 73 Date d'inscription mardi 9 juin 2015 Statut Membre Dernière intervention 28 juillet 2015
22 juin 2015 à 15:41
Nouveau point sur ma macro :
le dernier problème que j'avais vendredi? un pb d'opérateur numérique tout simplement.

Aujourd'hui, c'est plus compliqué :

je me suis rendue compte que ma condition 
'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

ne risquait pas de marcher, puisque je prennais liFM dans la feuille FM et coDL dans la feuille FS.

Du coup c'est mon premier pb du jour. J'ai tenté de déclarer un autre nom pour cette variable, j'ai tenté de changé ma formule en
si date - date de liv > 0 alors on efface
J'ai tenté pleins de choses différentes, je patauge dans la semoule : je n'arrive pas à effacer la bonne ligne et j'ai planté plusieurs fois excel...

Deuxième problème du jour :
J'ai ajouté des conditions à la fin de mon code pour prendre en compte les annulations de l'entreprise ou la non livraison des fournisseurs.
Dès que les conditions sont vraies, à la mise à jour suivante, ça cafouille. Je pense que j'ai un problème de pointeur qui se décale à chaque tour.
Si qqun veut m'aider, je mettrai mon code et mon doc dans un prochain post. Sinon je continue mes pataugages et cafouillages...
0
Réponse 8 / 9
mstecluque Messages postés 73 Date d'inscription mardi 9 juin 2015 Statut Membre Dernière intervention 28 juillet 2015
24 juin 2015 à 09:24
Bonjour à tous!

Un de mes derniers messages j'espère : ça y est ça marche!!
Sauf un tout petit pb évidemment : mon code ne respecte pas la condition de la ligne 90. Ca passe toujours pas l'autre côté.
Alors que la même chose fonctionne ligne 74.
Si qqun à une explication, je suis preneuse.
Merci d'avance. 

Option Explicit                                 'force la déclaration des variables
Option Base 1                                   'pour commencer l'index des tableaux à 1 au lieu de 0

Public Const FS = "Suivi des commandes"         'déclare comme constante FS pour Suivi de commandes
Const lidebFS = 5                               'déclare comme constante la ligne 5 comme ligne de début de parcours pour la feuille FS
Const coId = "A"                                'déclare comme constante la colonne A pour la colonne des identifiants
Const coDL = "W"                                'déclare comme constante la colonne W pour la colonne de Date de livraison réelle
Const coProb = "Y"                              'déclare comme constante la colonne Y pour la colonne de Problème à signaler
Const coProbA = "Z"                             'déclare comme constante la colonne Z pour la colonne de Problème déjà affiché


Public Const FM = "Mise à Jour Commandes"       'déclare comme constante FM pour Mise à jour Commandes
Public Const lidebFM = 3                        'déclare comme constante la ligne 3 comme ligne de début de parcours pour la feuille FM
Public Const codebFM = 1                        'déclare comme constante la colonne 1 comme colonne de début de parcours pour la feuille FM
Public Const cofinFM = 8                        'déclare comme constante la colonne 8 comme colonne de fin de parcours pour la feuille FM
Const coDLFM = "F"
Const coulNouv = 23                             'déclare comme constante la couleur de fond bleu en cas de nouveauté
Const coulPb = 22                               'déclare comme constante la couleur de fond rouge en cas de problème



Public Sub date_liv()

Dim liFS As Long                                'déclare la variable liFS (incrément)
Dim lifinFS As Long                             'déclare la variable ligne de fin de FS

Dim id As Long                                  'déclare l'identifiant

Dim liFM As Long                                'déclare la variable liFM (incrément)
Dim lifinFM As Long                             'déclare la variable ligne de fin de FM
Dim coFM As Long                                'déclare la variable coFM (incrément)

Dim objFM As Object                             'déclare l'objet FM
Dim liObjFM As Long                             'déclare la variable liObjFM (incrément)

Dim TcoFS()                                     'déclare la variable TcoFS (tableau des colonnes FS)


'--Début de la macro
'Arrêt du rafraîchissement de l'écran (augmente la rapidité 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, 25)

'Dernières lignes de FS et FM
lifinFS = Sheets(FS).Cells(Rows.Count, 1).End(xlUp).Row
lifinFM = Sheets(FM).Cells(Rows.Count, 1).End(xlUp).Row

'On appelle la fonction effacement
Call clear_tab

'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, coProbA).Value = "" Then
        'Si on ne trouve pas l'ID
        If objFM Is Nothing Then
            'Si la date de livraison est la date du jour ou une date postérieure
            If Sheets(FS).Cells(liFS, coDL).Value = Date Or Sheets(FS).Cells(liFS, coDL).Value = "" Then
                'On copie cet id dans FM
                lifinFM = Sheets(FM).Cells(Rows.Count, 1).End(xlUp).Row
                'Et pour chaque colonne de FM
                For coFM = 1 To cofinFM
                    Sheets(FS).Cells(liFS, TcoFS(coFM)).Copy
                    Sheets(FM).Cells(lifinFM + 1, coFM).PasteSpecial Paste:=xlPasteValues
                Next coFM
                For coFM = 1 To cofinFM
                    If Sheets(FM).Cells(lifinFM + 1, cofinFM).Value = "" Then
                        Sheets(FM).Cells(lifinFM + 1, coFM).Interior.ColorIndex = coulNouv
                    Else
                        Sheets(FM).Cells(lifinFM + 1, coFM).Interior.ColorIndex = coulPb
                    End If
                Next coFM
            End If
                
        ' 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 différentes on colorie la cellule
                 If Sheets(FS).Cells(liFS, TcoFS(coFM)).Value <> Sheets(FM).Cells(liObjFM, coFM).Value Then
                    If Sheets(FM).Cells(liObjFM, cofinFM).Value <> "" Then
                        Sheets(FM).Cells(liObjFM, coFM).Interior.ColorIndex = coulPb
                    Else
                        Sheets(FM).Cells(liObjFM, coFM).Interior.ColorIndex = coulNouv
                    End If
                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
    
        If Sheets(FS).Cells(liFS, coProb).Value <> "" And Sheets(FS).Cells(liFS, coProbA).Value = "" Then
            Sheets(FS).Cells(liFS, coProbA).Value = "Problème signalé"
        End If
    End If
Next liFS

'Redémarrage du rafraîchissement de l'écran
Application.ScreenUpdating = True

End Sub
'Fonction de nettoyage du tableau de FM
Sub clear_tab()

'Déclarations des données
Dim liFM As Long, lifinFM As Long

'Dernière ligne de FM
lifinFM = Sheets(FM).Cells(Rows.Count, 1).End(xlUp).Row
'On parcourt toutes les lignes de 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, coDLFM).Value < Date And Sheets(FM).Cells(liFM, coDLFM).Value <> "" Then
        Rows(liFM).Delete Shift:=xlUp
        liFM = liFM - 1
    End If
    If Sheets(FM).Cells(liFM, cofinFM).Value <> "" Then
        Rows(liFM).Delete Shift:=xlUp
        liFM = liFM - 1
    End If
Next liFM
End Sub
0
Réponse 9 / 9
mstecluque Messages postés 73 Date d'inscription mardi 9 juin 2015 Statut Membre Dernière intervention 28 juillet 2015
1 juil. 2015 à 09:45
Pour ceux que ça intéresserait, je mets ma macro terminée.
Merci à vous pour votre aide. 

Option Explicit                                 'force la déclaration des variables
Option Base 1                                   'pour commencer l'index des tableaux à 1 au lieu de 0

Public Const FS = "Suivi des commandes"         'déclare comme constante FS pour Suivi de commandes
Const lidebFS = 5                               'déclare comme constante la ligne 5 comme ligne de début de parcours pour la feuille FS
Const coId = "A"                                'déclare comme constante la colonne A pour la colonne des identifiants
Const coDL = "W"                                'déclare comme constante la colonne W pour la colonne de Date de livraison réelle
Const coProb = "Y"                              'déclare comme constante la colonne Y pour la colonne de Problème à signaler
Const coProbA = "Z"                             'déclare comme constante la colonne Z pour la colonne de Problème déjà affiché


Public Const FM = "Mise à Jour Commandes"       'déclare comme constante FM pour Mise à jour Commandes
Public Const lidebFM = 3                        'déclare comme constante la ligne 3 comme ligne de début de parcours pour la feuille FM
Public Const codebFM = 1                        'déclare comme constante la colonne 1 comme colonne de début de parcours pour la feuille FM
Public Const cofinFM = 8                        'déclare comme constante la colonne 8 comme colonne de fin de parcours pour la feuille FM
Const coDLFM = "F"
Const coulNouv = 23                             'déclare comme constante la couleur de fond bleu en cas de nouveauté
Const coulPb = 22                               'déclare comme constante la couleur de fond rouge en cas de problème



Public Sub date_liv()

Dim liFS As Long                                'déclare la variable liFS (incrément)
Dim lifinFS As Long                             'déclare la variable ligne de fin de FS

Dim id As Long                                  'déclare l'identifiant

Dim liFM As Long                                'déclare la variable liFM (incrément)
Dim lifinFM As Long                             'déclare la variable ligne de fin de FM
Dim coFM As Long                                'déclare la variable coFM (incrément)

Dim objFM As Object                             'déclare l'objet FM
Dim liObjFM As Long                             'déclare la variable liObjFM (incrément)

Dim TcoFS()                                     'déclare la variable TcoFS (tableau des colonnes FS)


'--Début de la macro
'Arrêt du rafraîchissement de l'écran (augmente la rapidité 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, 25)

'Dernières lignes de FS et FM
lifinFS = Sheets(FS).Cells(Rows.Count, 1).End(xlUp).Row
lifinFM = Sheets(FM).Cells(Rows.Count, 1).End(xlUp).Row

'On appelle la fonction effacement
Call clear_tab

'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, coProbA).Value = "" Then
        'Si on ne trouve pas l'ID
        If objFM Is Nothing Then
            'Si la date de livraison est la date du jour ou une date postérieure
            If Sheets(FS).Cells(liFS, coDL).Value = Date Or Sheets(FS).Cells(liFS, coDL).Value = "" Then
                'On copie cet id dans FM
                lifinFM = Sheets(FM).Cells(Rows.Count, 1).End(xlUp).Row
                'Et pour chaque colonne de FM
                For coFM = 1 To cofinFM
                    Sheets(FS).Cells(liFS, TcoFS(coFM)).Copy
                    Sheets(FM).Cells(lifinFM + 1, coFM).PasteSpecial Paste:=xlPasteValues
                Next coFM
                For coFM = 1 To cofinFM
                    If Sheets(FM).Cells(lifinFM + 1, cofinFM).Value = "" Then
                        Sheets(FM).Cells(lifinFM + 1, coFM).Interior.ColorIndex = coulNouv
                    Else
                        Sheets(FM).Cells(lifinFM + 1, coFM).Interior.ColorIndex = coulPb
                    End If
                Next coFM
            End If

        ' 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 différentes on colorie la cellule
                If Sheets(FS).Cells(liFS, TcoFS(coFM)).Value <> Sheets(FM).Cells(liObjFM, coFM).Value Then
                    ' on copie la cellule
                    Sheets(FS).Cells(liFS, TcoFS(coFM)).Copy
                    Sheets(FM).Cells(liObjFM, coFM).PasteSpecial Paste:=xlPasteValues
                    If Sheets(FM).Cells(liObjFM, cofinFM).Value <> "" Then
                        Sheets(FM).Range(Cells(liObjFM, 1), Cells(liObjFM, coFM)).Interior.ColorIndex = coulPb
                    Else
                        Sheets(FM).Cells(liObjFM, coFM).Interior.ColorIndex = coulNouv
                    End If
                Else
                    ' on copie la cellule, dans tous les cas
                    Sheets(FS).Cells(liFS, TcoFS(coFM)).Copy
                    Sheets(FM).Cells(liObjFM, coFM).PasteSpecial Paste:=xlPasteValues
                End If
                
            Next coFM
        End If
    
        If Sheets(FS).Cells(liFS, coProb).Value <> "" And Sheets(FS).Cells(liFS, coProbA).Value = "" Then
            Sheets(FS).Cells(liFS, coProbA).Value = "Problème signalé"
        End If
    End If
Next liFS

'Redémarrage du rafraîchissement de l'écran
Application.ScreenUpdating = True

End Sub
'Fonction de nettoyage du tableau de FM
Sub clear_tab()

'Déclarations des données
Dim liFM As Long, lifinFM As Long

'Dernière ligne de FM
lifinFM = Sheets(FM).Cells(Rows.Count, 1).End(xlUp).Row
'On parcourt toutes les lignes de 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, coDLFM).Value < Date And Sheets(FM).Cells(liFM, coDLFM).Value <> "" Then
        Rows(liFM).Delete Shift:=xlUp
        liFM = liFM - 1
    End If
    'On enlève la ligne s'il y a eu un pb signalé
    If Sheets(FM).Cells(liFM, cofinFM).Value <> "" Then
        Rows(liFM).Delete Shift:=xlUp
        liFM = liFM - 1
    End If
Next liFM
End Sub
0

Discussions similaires

Un seul de mes écouteurs marche. Que faire ?
VM_417 -
vali54 -

4 réponses
Comment supprimer une conversation Messenger pour les 2 personnes ?
mercidemaider -
sd -

7 réponses
Nettoyer une base de données avec une liste
TOT127 -
TOT127 -

11 réponses
Exemple de base de données access
Abdlahsaki -
Fleptche -

9 réponses