VBA - If ligne après ligne

Le 22/10/2019 à 10:14

Bonjour à tous et à toutes,

Après plusieurs recherche je ne trouve pas de solution à mon problème, je tente donc ici.

Je suis débutant...

Voici ma macro :

Private Sub Workbook_BeforeClose(Cancel As Boolean) 'attribution des valeurs et récupération des valeurs placé à l'ouverture OBJ2 = Worksheets("Synthèse com").Range("G6").Value * 100 OBJ1 = Worksheets("Résiliation").Range("B500") Contrat1 = Worksheets("Résiliation").Range("B501") Carte1 = Worksheets("Résiliation").Range("B502") Contrat2 = Worksheets("Synthèse com").Range("D16").Value + Worksheets("Synthèse com").Range("D17").Value - Contrat1 Carte2 = Worksheets("Synthèse com").Range("D18").Value - Carte1 'message afficher à la fermeture du classeur MsgBox ("Au revoir, Nous sommes à " & OBJ2 & "% de l'objectif du mois, vous avez signé " & Contrat2 & " contrat(s) et " & Carte2 & " carte(s), à demain") 'Je compare les données copier à l'ouverture du fichier avec les modifications apportés If Worksheets("Léo").Range("Z10:Z500").Select = Worksheets("Léo").Range("Y10:Y500").Select Then Else If Date = Worksheets("Léo").Range("A10:A500") + 2 Then Worksheets("Léo").Range("X10:X500") = 1 Else End If End If End Sub

C'est la seconde parti qui me bloque, le IF :

J'ai dans la colonne Z 0 ou 1. 1 etant fait et 0 pas fait.

Je veux savoir si c'est fait mais à une date précise, ici J+2.

J'ai donc précédemment à l'ouverture copier Z dans Y.

A la fermeture je compare Z avec Y, si c'est égale alors je rien car aucun changement.

Sinon, 0 pouvant devenir 1 mais pas l'inverse. alors

Si aujourd'hui = date prédéfinir + 2 alors

ajouter 1 dans la colonne X

Sinon rien

Et ce ligne par ligne entre la ligne 10 et ligne 500...

Dans l'espoir que vous m'appreniez quelque chose.

Sportivement,

PECOUD

Le 22/10/2019 à 10:36

Bonjour,

Cette syntaxe, c'est de la science fiction ! 

If Worksheets("Léo").Range("Z10:Z500").Select = Worksheets("Léo").Range("Y10:Y500").Select Then ...

Les "Select" n'ont rien à faire là, et on ne peut pas comparer des plages aussi facilement...

Un essai à tester :

Option Base 1
Function ComparePlages(PL1 As Range, PL2 As Range) As Boolean

'Déclaration des variables
Dim Res As Integer, Lig As Long, LigFin As Long, T1(), T2()

Res = 1
T1 = PL1.Value 'Affecte les valeurs de la plage 1 dans une variable tableau
T2 = PL2.Value 'Idem plage 2
LigFin = Application.Min(UBound(T1), UBound(T2)) 'Détermine la longueur de la plage la plus courte
For Lig = 1 To LigFin 'Boucle sur les lignes
        Res = Res * (T1(Lig, 1) = T2(Lig, 1)) 'Si les valeurs diffèrent une fois, Res prend la valeur 0
Next Lig
ComparePlages = CBool(Res) 'Résultat de la comparaison

End Function
Sub MaMacro()
'...
If ComparePlages(Worksheets("Léo").Range("Z10:Z500"),Worksheets("Léo").Range("Y10:Y500")) Then '...
'...
End Sub
Le 22/10/2019 à 11:35

Bonjour,

Je te remercie pour ta réponse..

Avant de me lancer dans quoi que ce soir, j'aimerais comprendre, et là je comprend pas grand chose.

Je ne sais pas quoi correspond à quoi et surtout comment l'adapter à mon tableau....

Peux-tu m'éclairer ?

Le 22/10/2019 à 11:56
Pecoud a écrit :

Bonjour,

Je te remercie pour ta réponse..

Avant de me lancer dans quoi que ce soir, j'aimerais comprendre, et là je comprend pas grand chose.

Je ne sais pas quoi correspond à quoi et surtout comment l'adapter à mon tableau....

Peux-tu m'éclairer ?

On ne peut pas écrire tout simplement SI PLAGE1 = PLAGE2 ALORS..., il faut comparer les plages cellule par cellule.

C'est ce que fait la fonction personnalisée dans le code proposé ci dessus. Dans les grandes lignes (voir commentaires dans le code pour les détails) :

  • Les 2 plages à comparer sont les arguments (les "entrées") de la fonction
  • Elle parcourt ensuite chaque ligne
  • Tant que Plage1(Ligne X) = Plage2(Ligne X) est VRAI (une égalité VRAIE renvoie 1, FAUX renvoie 0), Res reste égal à 1
  • Si une seule fois, cette égalité renvoie FAUX, Res prend définitivement la valeur 0 (les plages ne sont pas strictement égales)

Cette fonction peut ensuite être utilisée ailleurs dans d'autres macros, voire directement dans une cellule Excel.

Tu peux donc remplacer la 1ère ligne par la 2nde dans ta macro :

If Worksheets("Léo").Range("Z10:Z500").Select = Worksheets("Léo").Range("Y10:Y500").Select Then '...
If ComparePlages(Worksheets("Léo").Range("Z10:Z500"),Worksheets("Léo").Range("Y10:Y500")) Then '...
Le 22/10/2019 à 12:20

Bonjour,

Okey merci.

Cependant, je ne comprend toujours quoi remplacer et quoi prendre de la macro que tu m'as donner ?

Le 22/10/2019 à 12:31
Pecoud a écrit :

Bonjour,

Okey merci.

Cependant, je ne comprend toujours quoi remplacer et quoi prendre de la macro que tu m'as donner ?

Il n'y a rien à remplacer, j'ai déjà tout écrit sur la base de ton code... Il suffit donc de copier le code de la fonction (que je vais te redonner ci dessous au cas où ce n'est toujours pas clair), de le coller dans ton module VBA, et de changer la ligne mentionnée plus haut dans ton code !

Option Base 1
Function ComparePlages(PL1 As Range, PL2 As Range) As Boolean

'Déclaration des variables
Dim Res As Integer, Lig As Long, LigFin As Long, T1(), T2()

Res = 1
T1 = PL1.Value 'Affecte les valeurs de la plage 1 dans une variable tableau
T2 = PL2.Value 'Idem plage 2
LigFin = Application.Min(UBound(T1), UBound(T2)) 'Détermine la longueur de la plage la plus courte
For Lig = 1 To LigFin 'Boucle sur les lignes
        Res = Res * (T1(Lig, 1) = T2(Lig, 1)) 'Si les valeurs diffèrent une fois, Res prend la valeur 0
Next Lig
ComparePlages = CBool(Res) 'Résultat de la comparaison

End Function
Le 22/10/2019 à 12:34

Re,

ça me met "erreur de compilation"

Private Sub Workbook_BeforeClose(Cancel As Boolean)

'attribution des valeurs et récupération des valeurs placé à l'ouverture

OBJ2 = Worksheets("Synthèse com").Range("G6").Value * 100

OBJ1 = Worksheets("Résiliation").Range("B500")

Contrat1 = Worksheets("Résiliation").Range("B501")

Carte1 = Worksheets("Résiliation").Range("B502")

Contrat2 = Worksheets("Synthèse com").Range("D16").Value + Worksheets("Synthèse com").Range("D17").Value - Contrat1

Carte2 = Worksheets("Synthèse com").Range("D18").Value - Carte1

'message afficher à la fermeture du classeur

MsgBox ("Au revoir, Nous sommes à " & OBJ2 & "% de l'objectif du mois, vous avez signé " & Contrat2 & " contrat(s) et " & Carte2 & " carte(s), à demain")

'Je compare les données copier à l'ouverture du fichier avec les modifications apportés

Function ComparePlages(PL1 As Range, PL2 As Range) As Boolean

'Déclaration des variables

Dim Res As Integer, Lig As Long, LigFin As Long, T1(), T2()

Res = 1

T1 = PL1.Value 'Affecte les valeurs de la plage 1 dans une variable tableau

T2 = PL2.Value 'Idem plage 2

LigFin = Application.Min(UBound(T1), UBound(T2)) 'Détermine la longueur de la plage la plus courte

For Lig = 1 To LigFin 'Boucle sur les lignes

Res = Res * (T1(Lig, 1) = T2(Lig, 1)) 'Si les valeurs diffèrent une fois, Res prend la valeur 0

Next Lig

ComparePlages = CBool(Res) 'Résultat de la comparaison

End Function

If ComparePlages(Worksheets("Léo").Range("Z10:Z500"), Worksheets("Léo").Range("Y10:Y500")) Then

Else

If Date = Worksheets("Léo").Range("A10:A500") + 2 Then

Worksheets("Léo").Range("X10:X500") = 1

Else

End If

End If

End Function

End Function

Le 22/10/2019 à 12:36

Pour continuer, je n'ai pas cherché à comprendre l'intégralité de votre code, surtout que les explications jointes sont loin d'être claires...

Tout ce que je vous ai proposé ci-dessus vise simplement à pouvoir comparer 2 plages de manière correcte.

Néanmoins, il vous reste encore à retravailler ces instructions car le problème est similaire :

If Date = Worksheets("Léo").Range("A10:A500") + 2 Then Worksheets("Léo").Range("X10:X500") = 1

On n'effectue pas directement de comparaison ou d'opération sur des plages complètes. Il faut parcourir chaque cellule à l'aide d'une boucle*, pour répéter l'opération cellule par cellule.

*Exemples :

For VariableDeBoucle = NbDébut To NbFin
    'Instructions
Next VariableDeBoucle
For Each Cellule In PlageCellules
    'Instructions
Next Cellule
Le 22/10/2019 à 12:41
Pecoud a écrit :

Re,

ça me met "erreur de compilation"

Purée je vais en chier !

Copiez strictement le code de la fonction, tel qu'il est dans mon message précédent et coller le à part, tout seul, peinard, bien au chaud dans un module standard de VBA (et non dans le module "ThisWorkbook").

Vous voilà l'heureux détenteur d'une fonction générique capable de comparer 2 plages. La fonction renvoie VRAI si les 2 plages sont identiques, FAUX le cas inverse. Du coup, vous pouvez désormais l'utiliser dans n'importe quelle macro ailleurs dans VBA de la manière suivante :

'Gnagnagna...lignes de code d'une macro...
NomDeMaFonction(Argument1,Argument2,...)
'Gnagnagna...lignes de code d'une macro...

Du coup, reprenez votre propre code, et changez juste, seulement, et uniquement la ligne mentionnée dans tous mes précédents messages pour utiliser cette fonction magique à la plage de votre syntaxe initiale hasardeuse...

If Worksheets("Léo").Range("Z10:Z500").Select = Worksheets("Léo").Range("Y10:Y500").Select Then '...
'Devient :
If ComparePlages(Worksheets("Léo").Range("Z10:Z500"),Worksheets("Léo").Range("Y10:Y500")) Then '...
Le 22/10/2019 à 12:46

Bonjour,

J'ai compris, comme ça :

Function ComparePlages(PL1 As Range, PL2 As Range) As Boolean 'Déclaration des variables Dim Res As Integer, Lig As Long, LigFin As Long, T1(), T2() Res = 1 T1 = PL1.Value 'Affecte les valeurs de la plage 1 dans une variable tableau T2 = PL2.Value 'Idem plage 2 LigFin = Application.Min(UBound(T1), UBound(T2)) 'Détermine la longueur de la plage la plus courte For Lig = 1 To LigFin 'Boucle sur les lignes Res = Res * (T1(Lig, 1) = T2(Lig, 1)) 'Si les valeurs diffèrent une fois, Res prend la valeur 0 Next Lig ComparePlages = CBool(Res) 'Résultat de la comparaison End Function Private Sub Workbook_BeforeClose(Cancel As Boolean) 'attribution des valeurs et récupération des valeurs placé à l'ouverture OBJ2 = Worksheets("Synthèse com").Range("G6").Value * 100 OBJ1 = Worksheets("Résiliation").Range("B500") Contrat1 = Worksheets("Résiliation").Range("B501") Carte1 = Worksheets("Résiliation").Range("B502") Contrat2 = Worksheets("Synthèse com").Range("D16").Value + Worksheets("Synthèse com").Range("D17").Value - Contrat1 Carte2 = Worksheets("Synthèse com").Range("D18").Value - Carte1 'message afficher à la fermeture du classeur MsgBox ("Au revoir, Nous sommes à " & OBJ2 & "% de l'objectif du mois, vous avez signé " & Contrat2 & " contrat(s) et " & Carte2 & " carte(s), à demain") 'Je compare les données copier à l'ouverture du fichier avec les modifications apportés If ComparePlages(Worksheets("Léo").Range("Z10:Z500"), Worksheets("Léo").Range("Y10:Y500")) Then Else If Date = Worksheets("Léo").Range("A10:A500") + 2 Then Worksheets("Léo").Range("X10:X500") = 1 Else End If End If End Sub

Le 22/10/2019 à 12:53
Pecoud a écrit :

Bonjour,

J'ai compris, comme ça :

On avance, c'est presque ça, sauf que votre code est actuellement dans le module VBA "ThisWorkbook", qui ne convient pas pour le code la fonction (et uniquement le code de la fonction).

Le 22/10/2019 à 13:04

Re,

J'ai donc ça dans un module

Function ComparePlages(PL1 As Range, PL2 As Range) As Boolean 'Déclaration des variables Dim Res As Integer, Lig As Long, LigFin As Long, T1(), T2() Res = 1 T1 = PL1.Value 'Affecte les valeurs de la plage 1 dans une variable tableau T2 = PL2.Value 'Idem plage 2 LigFin = Application.Min(UBound(T1), UBound(T2)) 'Détermine la longueur de la plage la plus courte For Lig = 1 To LigFin 'Boucle sur les lignes Res = Res * (T1(Lig, 1) = T2(Lig, 1)) 'Si les valeurs diffèrent une fois, Res prend la valeur 0 Next Lig ComparePlages = CBool(Res) 'Résultat de la comparaison End Function

et ça dans mon workbook !

Private Sub Workbook_BeforeClose(Cancel As Boolean) 'attribution des valeurs et récupération des valeurs placé à l'ouverture OBJ2 = Worksheets("Synthèse com").Range("G6").Value * 100 OBJ1 = Worksheets("Résiliation").Range("B500") Contrat1 = Worksheets("Résiliation").Range("B501") Carte1 = Worksheets("Résiliation").Range("B502") Contrat2 = Worksheets("Synthèse com").Range("D16").Value + Worksheets("Synthèse com").Range("D17").Value - Contrat1 Carte2 = Worksheets("Synthèse com").Range("D18").Value - Carte1 'message afficher à la fermeture du classeur MsgBox ("Au revoir, Nous sommes à " & OBJ2 & "% de l'objectif du mois, vous avez signé " & Contrat2 & " contrat(s) et " & Carte2 & " carte(s), à demain") 'Je compare les données copier à l'ouverture du fichier avec les modifications apportés If ComparePlages(Worksheets("Léo").Range("Z10:Z500"), Worksheets("Léo").Range("Y10:Y500")) Then Else If Date = Worksheets("Léo").Range("A10:A500") + 2 Then Worksheets("Léo").Range("X10:X500") = 1 Else End If End If End Sub

Quelle resultat de votre fonction ressort donc pour ma condition ?

Le 22/10/2019 à 13:58
Pecoud a écrit :

Re,

Quelle resultat de votre fonction ressort donc pour ma condition ?

Bien pour le placement des codes.

Pour votre question, aucune idée je ne connais pas le contenu de votre fichier.

Mais comme indiqué précédemment, la suite de votre code comporte encore des incohérences du même type.

Je vous renvoie vers cette réponse :

Pedro22 a écrit :

Néanmoins, il vous reste encore à retravailler ces instructions car le problème est similaire :

If Date = Worksheets("Léo").Range("A10:A500") + 2 Then Worksheets("Léo").Range("X10:X500") = 1

On n'effectue pas directement de comparaison ou d'opération sur des plages complètes. Il faut parcourir chaque cellule à l'aide d'une boucle*, pour répéter l'opération cellule par cellule.

*Exemples :

For VariableDeBoucle = NbDébut To NbFin
    'Instructions
Next VariableDeBoucle
For Each Cellule In PlageCellules
    'Instructions
Next Cellule
Le 22/10/2019 à 15:00

Re,

Voici mon code :

If ComparePlages(Worksheets("Léo").Range("Z10:Z500"), Worksheets("Léo").Range("Y10:Y500")) Then Else For Each Cellule In Worksheets("Léo").Range("A10:A500").Cells 'Instructions If Cellule + 2 = Date Then Worksheets("Léo").Range("X10:X500") = 1 Else End If Next Cellule End If End Sub

Si c'est ok à ce niveau, j'ai un problème pour le Worksheets("Léo").Range("X10:X500") = 1

Je ne sais pas ajouter un 1 dans la même ligne mais dans une colonne différente, ici placet un 1 dans la colonne X ?

Est-ce claire ?

Le 22/10/2019 à 15:09
Pecoud a écrit :

Re,

Voici mon code :

If ComparePlages(Worksheets("Léo").Range("Z10:Z500"), Worksheets("Léo").Range("Y10:Y500")) Then Else For Each Cellule In Worksheets("Léo").Range("A10:A500").Cells 'Instructions If Cellule + 2 = Date Then Worksheets("Léo").Range("X10:X500") = 1 Else End If Next Cellule End If End Sub

Si c'est ok à ce niveau, j'ai un problème pour le Worksheets("Léo").Range("X10:X500") = 1

Je ne sais pas ajouter un 1 dans la même ligne mais dans une colonne différente, ici placet un 1 dans la colonne X ?

Est-ce claire ?

Petite astuce pour commencer, la mise en forme du code sur le forum se fait grâce au bouton </>, qui facilite vraiment la lecture.

Comme indiqué précédemment, cette instruction n'est pas valide :

Worksheets("Léo").Range("X10:X500") = 1

Mais n'ayant toujours pas bien saisit l'objectif de la manip', je ne sais pas par quoi le remplacer à ce stade.

Voilà une correction grossière de votre extrait de code, d'après ce que j'ai saisis :

With Worksheets("Léo")
    If Not ComparePlages(.Range("Z10:Z500"), .Range("Y10:Y500")) Then
         For Each Cellule In .Range("A10:A500")
             If Cellule.Value + 2 = Date Then Cellule.Offset(0,-1) = 1 'Offset est utilisé pour travailler avec un décalage de X lignes et Y colonnes par rapport à la cellule de départ
         Next Cellule
     End If
End With
Le 22/10/2019 à 15:24

Re,

L'idée est la suivante :

dans la colonne Z, les cellules sont vides, ou egale à 1 quand ici une relance 48h est faites.

Je veux pouvoir déterminé si les relances 48h sont faites au bout des 48h.

Je suis partis sur le principe de comparer l'ouverture et la fermeture du fichier grâce à la copie des données dans la colonne Y à l'ouverture, étant donné que les donné dans la colonne Z sont amener à etre modifier par l'utilisateur.

A la fermeture je compare, si c'est égale, alors aucune relance n'a été faite, si c'est différent alors la relance a été faite, je regarde alors quelle jour nous sommes ici

date

et la compare avec la date à laquel la relance 48h aurait dû être fait (celle ci se trouve dans la colonne A, soit A + 2 jours.

Si aujourd'hui = A + 2 alors donner le résultat dans la colonne X, si oui alors 1 sinon rien.

Le 22/10/2019 à 15:37

Re,

With Worksheets("Léo")
         For Each Cellule In .Range("A10:A500")
          If Not ComparePlages(.Range("Z10:Z500"), .Range("Y10:Y500")) Then
             If Cellule.Value + 2 = Date Then Cellule.Offset(0, 23) = 1 'Offset est utilisé pour travaillé avec une décalage de X lignes et Y colonnes par rapport à la cellule de départ
            End If
            Next Cellule
            End With

End Sub

ça fonctionne presque, le IF ne prend pas en compte la comparaison entre la colonne Z et Y...

Pour le reste c'est ok, je voudrais que si la cellule Z et Y sont identique alors rien, si elles sont différentes ajouter 1 dans X si A+2= aujourd'hui...

J'ai l'impression de parler chinois....

Le 22/10/2019 à 15:46
Pecoud a écrit :

Re,

With Worksheets("Léo")
         For Each Cellule In .Range("A10:A500")
          If Not ComparePlages(.Range("Z10:Z500"), .Range("Y10:Y500")) Then
             If Cellule.Value + 2 = Date Then Cellule.Offset(0, 23) = 1 'Offset est utilisé pour travaillé avec une décalage de X lignes et Y colonnes par rapport à la cellule de départ
            End If
            Next Cellule
            End With

End Sub

ça fonctionne presque, le IF ne prend pas en compte la comparaison entre la colonne Z et Y...

Pour le reste c'est ok, je voudrais que si la cellule Z et Y sont identique alors rien, si elles sont différentes ajouter 1 dans X si A+2= aujourd'hui...

J'ai l'impression de parler chinois....

On s'est surtout mal compris au départ. La fonction proposée compare l'ensemble d'une colonne avec une autre, tandis que là l'intérêt est plutôt de comparer ligne par ligne...

Le 22/10/2019 à 15:49

Nouvelle proposition :

With Worksheets("Léo")
         For Lig = 10 To 500
             If .Range("Y" & Lig)  <> .Range("Z" & Lig) And .Range("A" & Lig) + 2 = Date Then .Range("X" & Lig)  = 1
         Next Lig
End With
Le 22/10/2019 à 15:53
Pecoud a écrit :

Re,

J'ai l'impression de parler chinois....

On débute tous un jour, mais l'idéal est quand même d'aller faire un tour du côté des sections de cours et des tutoriels avant de se lancer bille en tête dans un sujet VBA.

Faire du code, c'est bête et méchant, et l'ordinateur ne pardonne aucune erreur de syntaxe, problème de virgule, etc...

Rechercher des sujets similaires à "vba ligne"