vérification de condition entre deux cellule de mémé colonne par macro

MINO

XLDnaute Junior
Bonsoir,

je doit trouver un macro qui doit m'afficher la différence entre deux cellules ( 2 par 2 ) de la même colonne ( colonne A) de toute le feuille Active ( line 1 et line 2)
je m'explique:
il faut faire une comparaison entre A2-A1 puis A3-A2 ….. Toute une boucle et vérifier si la différance entre les deux cellules dépasse 1 comme dans le cas de la différance A11-A10 = 1.1 de line2 et A7-A6 sachant que la valeur et une fois ascendant et une fois descendant donc il faut toujours multiplier *-1 en cas d’un résultat négative.
A fin de vérifier la condition un message s’apparue en mentionnant la line ou la condition et vérifier (line 1 + line 2 ) ( line3 non verifier )
la message doit être comme suit « stp de vérifier la line1 et line 2) sachant que nombre de line et plus que 20 line
merci
 

Pièces jointes

  • Classeur2.xlsx
    9.7 KB · Affichages: 55
  • Classeur2.xlsx
    9.7 KB · Affichages: 51
  • Classeur2.xlsx
    9.7 KB · Affichages: 60

Robert

XLDnaute Barbatruc
Repose en paix
Re : vérification de condition entre deux cellule de mémé colonne par macro

Bonjour Mino, bonjour le forum,

Peut-être comme ça :
Code:
Sub Macro1()
Dim O As Object 'déclare la variable O (Onglets)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim I As Integer 'déclare la variable I (Incrément)

For Each O In Sheets 'boucle 1 : sur tous les onglets O du classeur
    O.UsedRange.Interior.ColorIndex = xlNone 'supprime les éventuelles couleurs dans la plage éditée
    DL = O.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définie la dernière ligne éditée DL de la colonne 1 (=A) de l'onglet O
    For I = 1 To DL - 1 'boucle 2 : des lignes 1 à (DL - 1)
        'condition : si la valeur absolue de la différence entre la cellule ligne (I + 1) et
        'celle en ligne I de la colonne 1 est supérieure à 1
        If Abs(CDbl(O.Cells(I + 1, 1).Value) - CDbl(O.Cells(I, 1))) > 1 Then
            O.Range(O.Cells(I, 1), O.Cells(I + 1, 1)).Interior.ColorIndex = 3 'colore les deux cellules de rouge
            MsgBox "Veuillez vérifier les lignes " & I & " et " & I + 1 & " de l'onget " & O.Name & " !" 'message
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
Next O 'prochain onglet de la boucle 1
End Sub
 

MINO

XLDnaute Junior
Re : vérification de condition entre deux cellule de mémé colonne par macro

Bonjour Mino, bonjour le forum,

Peut-être comme ça :
Code:
Sub Macro1()
Dim O As Object 'déclare la variable O (Onglets)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim I As Integer 'déclare la variable I (Incrément)

For Each O In Sheets 'boucle 1 : sur tous les onglets O du classeur
    O.UsedRange.Interior.ColorIndex = xlNone 'supprime les éventuelles couleurs dans la plage éditée
    DL = O.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définie la dernière ligne éditée DL de la colonne 1 (=A) de l'onglet O
    For I = 1 To DL - 1 'boucle 2 : des lignes 1 à (DL - 1)
        'condition : si la valeur absolue de la différence entre la cellule ligne (I + 1) et
        'celle en ligne I de la colonne 1 est supérieure à 1
        If Abs(CDbl(O.Cells(I + 1, 1).Value) - CDbl(O.Cells(I, 1))) > 1 Then
            O.Range(O.Cells(I, 1), O.Cells(I + 1, 1)).Interior.ColorIndex = 3 'colore les deux cellules de rouge
            MsgBox "Veuillez vérifier les lignes " & I & " et " & I + 1 & " de l'onget " & O.Name & " !" 'message
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
Next O 'prochain onglet de la boucle 1
End Sub

Hallo Robert,
une tres garnde merci pour toi ca fonctionne tres b1 mais et t´il possible la verification de condition sera entre les cellule de colonne D on comancant par D6( d7-d6)( et n´oublier pas la contrainte que d7 pas mal de fois peut erte inferieur a D6) et verifier cette condition seulemt avec les feuilles qui commance par Line ( line 1 + line2 ) vu que dans notre planification il a d´autre feuille telque la feuille (Planification+client ....)
merci
 

Pièces jointes

  • PLANIFICATION.xlsx
    216.2 KB · Affichages: 38
  • PLANIFICATION.xlsx
    216.2 KB · Affichages: 38
  • PLANIFICATION.xlsx
    216.2 KB · Affichages: 32

Robert

XLDnaute Barbatruc
Repose en paix
Re : vérification de condition entre deux cellule de mémé colonne par macro

Bonjour Mino, bonjour le forum,

je maîtrise mal le calcul du temps... En pièce jointe une version adaptée avec le code ci-dessous :
Code:
Sub Macro1()
Dim O As Object 'déclare la variable O (Onglets)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim I As Integer 'déclare la variable I (Incrément)
Dim t1 As Variant 'décale la variable t2 (Temps 1)
Dim t2 As Variant 'décale la variable t2 (Temps 2)

For Each O In Sheets 'boucle 1 : sur tous les onglets O du classeur
    If UCase(Left(O.Name, 4)) = "LINE" Then 'condition : si le nom de l'onglet commence en majuscule par "LINE"
        DL = O.Cells(Application.Rows.Count, 4).End(xlUp).Row 'définie la dernière ligne éditée DL de la colonne 1 (=A) de l'onglet O
        Set PL = O.Range("D6:D" & DL) 'définit la plage PL
        PL.Interior.ColorIndex = 36 'supprime les éventuelles couleurs rouge dans la plage PL
        For I = 6 To DL - 1 'boucle 2 : des lignes 1 à (DL - 1)
            'condition : si la valeur absolue de la différence entre la cellule ligne (I + 1) et
            'celle en ligne I de la colonne 1 est supérieure à 1
            t1 = TimeSerial(Hour(O.Cells(I, 4).Value), Minute(O.Cells(I, 4).Value), Second(O.Cells(I, 4).Value)) 'définit la variable t1
            t2 = TimeSerial(Hour(O.Cells(I + 1, 4).Value), Minute(O.Cells(I + 1, 4).Value), Second(O.Cells(I + 1, 4).Value)) 'définit la variable t2
            If Abs(CDate(t2 - t1)) * 86400 > 1.000001 Then 'si la valeur absolue de la différence est supérieure à 1,000001
                O.Cells(I, 4).Interior.ColorIndex = 3 'colore la première cellule de rouge
                O.Cells(I + 1, 4).Interior.ColorIndex = 37 'colore la seconde cellule de vert
                'MsgBox "Veuillez vérifier les lignes " & I & " et " & I + 1 & " de l'onget " & O.Name & " !" 'message
            End If 'fin de la condition
        Next I 'prochaine ligne de la boucle 2
    End If 'fin de la condition
Next O 'prochain onglet de la boucle 1
End Sub
Le fichier :
 

Pièces jointes

  • Mino_v01.xlsm
    229.5 KB · Affichages: 47

MINO

XLDnaute Junior
Re : vérification de condition entre deux cellule de mémé colonne par macro

bonsoir a tous , bonsoir robert ,
quelqu'un peut me dire pourquoi c'est macro c débogue.
merci
mino
 

Pièces jointes

  • image001.jpg
    image001.jpg
    43.4 KB · Affichages: 76
  • image001.jpg
    image001.jpg
    43.4 KB · Affichages: 96
  • image001.jpg
    image001.jpg
    43.4 KB · Affichages: 100

Robert

XLDnaute Barbatruc
Repose en paix
Re : vérification de condition entre deux cellule de mémé colonne par macro

Bonsoir Mino, bonsoir le forum,

Oui je sais et c'est de ma faute ! Car j'ai oublié de te dire que dans ton fichier original, dans l'onglet Line 01, j'ai effacé la plage D32:D70 qui contenait des formules qui faisaient planter le code. Comme de D6 à D31 c'était des valeurs en dur (pas des formules) et que dans l'onglet Line 02 il n'y avait aucune formule dans la colonne D, j'ai pensé que ça n'aurait pas d'importance...
Si tu effaces le contenu de la plage D32:D70 tu n'auras, normalement, plus de plantage. Sinon il faudrait que je modifie le code...
 

MINO

XLDnaute Junior
Re : vérification de condition entre deux cellule de mémé colonne par macro

bonjour Robert ,
il faut que la formule soit toujours existe jusqu'ou D70 parceque il est relie a la nombre de commandes des client sur une chaine de production donc il faut que la fonction toujours exsite .(est t´il possible de corrige cette eurreur)
une tres grande merci pour ton aide
 

MINO

XLDnaute Junior
Re : vérification de condition entre deux cellule de mémé colonne par macro

bonjour Robert ,
je l'ai trouvée , il faut tout simplement ajouter cette code au debut de notre code macro precedent
Dim Feuille As Worksheet
For Each Feuille In ActiveWorkbook.Sheets
If Feuille.Name Like "Line ##" Then Feuille.Range("d6:d70").Value = Feuille.Range("d6:d70").Value
Next Feuille
svp de verifier ou d´ameliore
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : vérification de condition entre deux cellule de mémé colonne par macro

Bonjour Mino, bonjour le forum,

Je code que tu proposes va aussi effacer le contenu des cellules qui contiennent des formules ! Si tu veux garder les formules voici le code modifié :
Code:
Sub Macro1()
Dim O As Object 'déclare la variable O (Onglets)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim I As Integer 'déclare la variable I (Incrément)
Dim t1 As Variant 'décale la variable t2 (Temps 1)
Dim t2 As Variant 'décale la variable t2 (Temps 2)

For Each O In Sheets 'boucle 1 : sur tous les onglets O du classeur
    If UCase(Left(O.Name, 4)) = "LINE" Then 'condition : si le nom de l'onglet commence en majuscule par "LINE"
        O.Range("D6:D70").Interior.ColorIndex = 36 'supprime les éventuelles couleurs dans la plage PL
        On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
        Set PL = O.Range("D6:D70").SpecialCells(xlCellTypeConstants) 'définit la plage PL des cellules de D6:D70 ne contenant pas de formule (peut générer une erreur si il n'y a que des formules)
        If Err <> 0 Then Err.Clear: GoTo suite 'si une erreur a été générée, supprime l'erreur, passe à l'onglet suivant via l'étiquette "Suite"
        On Error GoTo 0 'annule la gestion des erreurs
        DL = PL.Rows.Count + 5 'définit la dernière ligne DL
        For I = 6 To DL - 1 'boucle 2 : des lignes 6 à (DL - 1)
            'condition : si la valeur absolue de la différence entre la cellule ligne (I + 1) et
            'celle en ligne I de la colonne 1 est supérieure à 1
            t1 = TimeSerial(Hour(O.Cells(I, 4).Value), Minute(O.Cells(I, 4).Value), Second(O.Cells(I, 4).Value)) 'définit la variable t1
            t2 = TimeSerial(Hour(O.Cells(I + 1, 4).Value), Minute(O.Cells(I + 1, 4).Value), Second(O.Cells(I + 1, 4).Value)) 'définit la variable t2
            If Abs(CDate(t2 - t1)) * 86400 > 1.000001 Then 'si la valeur absolue de la différence est supérieure à 1,000001
                O.Cells(I, 4).Interior.ColorIndex = 3 'colore la première cellule de rouge
                O.Cells(I + 1, 4).Interior.ColorIndex = 37 'colore la seconde cellule de vert
                'MsgBox "Veuillez vérifier les lignes " & I & " et " & I + 1 & " de l'onget " & O.Name & " !" 'message
            End If 'fin de la condition
        Next I 'prochaine ligne de la boucle 2
    End If 'fin de la condition
suite: 'étiquette
Next O 'prochain onglet de la boucle 1
End Sub

Sinon, juste par curiosité, de quel pays es-tu Mino ?

Le fichier :
 

Pièces jointes

  • Mino_v02.xlsm
    229.3 KB · Affichages: 56

Discussions similaires

Réponses
22
Affichages
755

Statistiques des forums

Discussions
312 176
Messages
2 085 955
Membres
103 059
dernier inscrit
gib17