J'ai fait une macro qui marche parfaitement, sauf pour une condition.
En résumé, j'ai fait une macro qui récupère les valeurs qui m'intéressent dans un tableau et les met dans un autre.
Elle copie donc les lignes selon certaines conditions.
Et ça marche sauf pour une, pas vraiment différente des autres. Ca fait quasiment une semaine que j'essaie de comprendre pourquoi ça ne fonctionne pas.
Donc si vous pouviez m'aider...
La condition qui ne fonctionne pas est à la ligne 90.
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 '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
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
J'ai toujours la coulNouv. Et en effet c'est une valeur non numérique, mais je ne pense pas que ça pose pb, si?
Difficile de répondre sans voir le fichier. Mettez un point d'arrêt sur la ligne en défaut et lancez votre macro puis avancez en pas à pas (avec F8), si ça passe faite F5 pour continuer le programme jusqu'au prochain arrêt et ainsi de suite.
La ligne en question, est-elle sollicité plusieurs fois et à chaque fois ça passe sauf une seule fois, ou bien l'est-elle qu'une seule fois et ça coince?Si ça coince: quelle information est renvoyée? Si vous ne trouvez pas, postez votre fichier (sans données sensibles) sur cjoint.com.
cdlt
Mon problème c'était que je testais une case toujours vide, puisque je faisais la copie juste après.
Maintenant j'ai une autre question qui n'a rien à voir.
Comment faire pour colorer l'intérieur de toute une ligne, sans boucle?
J'ai toujours la coulNouv. Et en effet c'est une valeur non numérique, mais je ne pense pas que ça pose pb, si?
Mettez un point d'arrêt sur la ligne en défaut et lancez votre macro puis avancez en pas à pas (avec F8), si ça passe faite F5 pour continuer le programme jusqu'au prochain arrêt et ainsi de suite.
La ligne en question, est-elle sollicité plusieurs fois et à chaque fois ça passe sauf une seule fois, ou bien l'est-elle qu'une seule fois et ça coince? Si ça coince: quelle information est renvoyée?
Si vous ne trouvez pas, postez votre fichier (sans données sensibles) sur cjoint.com.
cdlt
.
Maintenant j'ai une autre question qui n'a rien à voir.
Comment faire pour colorer l'intérieur de toute une ligne, sans boucle?
me colore une seule cellule en rouge.
Je voudrais que ça colore la ligne complète.