Exécuter une macro de lignes en lignes même si ligne vide

Résolu
Maksime568 Messages postés 145 Statut Membre -  
Maksime568 Messages postés 145 Statut Membre -
Bonjour,

j'ai un fichier avec des macros statuant sur des validations de pièces selon certains critères.
mais j'ai un soucis dans les macros que je ne comprend pas.
Si je rentre des valeurs en Q254 et R254 dans le fichier joint, la mecro fonctionne assez bien.
Mais il m'arrive parfois de devoir sauter une ligne car une pièce ne passe pas en test.
Et la c'est le drame, la macro ne détecte pas.
Pour infos la colonne E est toujours remplie, ça pourrait servir de base pour savoir si la macro doit continuer non?

Autre petit problème dans la macro.
Si Q est compris entre 0 et 10 et R compris entre 0 et 3 alors S =OK
Ou Si Q est compris entre 0 et 3 et R est vide alors S = OK.
mais en réalité là, si je rentre une valeur de Q supérieur à 3, la macro ne prend pas en compte la valeur de R. pourquoi?

de même pour la valeur en U qui ne doit s'inscrire que si G contient un texte spécifique. la formule ne suit pas.

Autre chose, est-ce possible que dans les cellules finales de réceptions des macros, s'inscrive uniquement OK ou NOK et non pas la formule complète?
Merci

http://www.cjoint.com/data/0DrkEJA77JC.htm

4 réponses

  1.
    Patrice33740 Messages postés 8400 Date d'inscription   Statut Membre Dernière intervention   1 783
     
    Re,

    Une des solutions consiste donc à régénérer systématiquement les formules des colonnes P, S, T, U et X chaque fois qu'une donnée est saisie.
    Ajoutes ce code dans le module de la feuille : 

    Private Sub Worksheet_Change(ByVal Target As Range)
Dim p As Long, d As Long, c As Range
  p = 7
  d = Cells(p, "E").End(xlDown).Row
  If Target.Row < p Or Target.Row > d Then Exit Sub
  'régénerer les formules
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Application.EnableEvents = False
  For Each c In Intersect(Columns("P"), Target.EntireRow)
    c.FormulaR1C1Local = "=SI(OU(LC(1)<>"""";LC(2)<>"""");SI(OU(LC(1)=""HS"";LC(2)=""HS"");""NOK"";""OK"");"""")"
  Next c
  For Each c In Intersect(Columns("S"), Target.EntireRow)
    c.FormulaR1C1Local = "=SI(LC(-3)<>"""";SI(OU(ET(LC(-2)>0;LC(-2)<3;LC(-1)="""");(ET(LC(-2)>0;LC(-2)<10;LC(-1)>0;LC(-1)<3)));""OK"";""NOK"");"""")"
  Next c
  For Each c In Intersect(Columns("T"), Target.EntireRow)
    c.FormulaR1C1Local = "=SI(ET(LC(-11)="""";LC(-10)="""";LC(-9)="""";LC(-1)=""OK"");""OK"";SI(ET(LC(-11)="""";LC(-10)="""";LC(-9)="""";LC(-1)="""");"""";""NOK""))"
  Next c
  For Each c In Intersect(Columns("U"), Target.EntireRow)
    c.FormulaR1C1Local = "=SI(ET(LC(-14)=""cyclage thermique"");SI(ET(LC(1)<>"""");SI(ET(LC(2)<>"""");SI(ET(LC(1)>0;LC(1)<10);SI(ET(LC(2)>0,01;LC(2)<5);""OK"";""NOK"");""NOK"");"""");""EN TEST"");"""")"
  Next c
  For Each c In Intersect(Columns("X"), Target.EntireRow)
    c.FormulaR1C1Local = "=SI(LC(-3)=""EN TEST"";"""";SI(ET(LC(-3)<>"""");SI(ET(LC(-3)=""OK"");SI(ET(LC(-2)>0;LC(-2)<=10);SI(ET(LC(-1)>0;LC(-1)<=5);SI(LC(-1)="""";""NOK"";""OK"");""NOK"");""NOK"");""NOK"");""""))"
  Next c
  Application.EnableEvents = True
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub

    1
    1. Patrice33740 Messages postés 8400 Date d'inscription   Statut Membre Dernière intervention   1 783
       
      Et si tu ne veux pas conserver les formules : 
      Private Sub Worksheet_Change(ByVal Target As Range)
Dim p As Long, d As Long, c As Range
  p = 7
  d = Cells(p, "E").End(xlDown).Row
  If Target.Row < p Or Target.Row > d Then Exit Sub
  'régénerer les formules
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Application.EnableEvents = False
  For Each c In Intersect(Columns("P"), Target.EntireRow)
    c.FormulaR1C1Local = "=SI(OU(LC(1)<>"""";LC(2)<>"""");SI(OU(LC(1)=""HS"";LC(2)=""HS"");""NOK"";""OK"");"""")"
    c.Value = c.Value
  Next c
  For Each c In Intersect(Columns("S"), Target.EntireRow)
    c.FormulaR1C1Local = "=SI(LC(-3)<>"""";SI(OU(ET(LC(-2)>0;LC(-2)<3;LC(-1)="""");(ET(LC(-2)>0;LC(-2)<10;LC(-1)>0;LC(-1)<3)));""OK"";""NOK"");"""")"
    c.Value = c.Value
  Next c
  For Each c In Intersect(Columns("T"), Target.EntireRow)
    c.FormulaR1C1Local = "=SI(ET(LC(-11)="""";LC(-10)="""";LC(-9)="""";LC(-1)=""OK"");""OK"";SI(ET(LC(-11)="""";LC(-10)="""";LC(-9)="""";LC(-1)="""");"""";""NOK""))"
    c.Value = c.Value
  Next c
  For Each c In Intersect(Columns("U"), Target.EntireRow)
    c.FormulaR1C1Local = "=SI(ET(LC(-14)=""cyclage thermique"");SI(ET(LC(1)<>"""");SI(ET(LC(2)<>"""");SI(ET(LC(1)>0;LC(1)<10);SI(ET(LC(2)>0,01;LC(2)<5);""OK"";""NOK"");""NOK"");"""");""EN TEST"");"""")"
    c.Value = c.Value
  Next c
  For Each c In Intersect(Columns("X"), Target.EntireRow)
    c.FormulaR1C1Local = "=SI(LC(-3)=""EN TEST"";"""";SI(ET(LC(-3)<>"""");SI(ET(LC(-3)=""OK"");SI(ET(LC(-2)>0;LC(-2)<=10);SI(ET(LC(-1)>0;LC(-1)<=5);SI(LC(-1)="""";""NOK"";""OK"");""NOK"");""NOK"");""NOK"");""""))"
    c.Value = c.Value
  Next c
  Application.EnableEvents = True
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub
      0
      1. Maksime568 Messages postés 145 Statut Membre > Patrice33740 Messages postés 8400 Date d'inscription   Statut Membre Dernière intervention  
         
        Bonjour Patrice,

        alors là parfait.
        Merci énormément c'est juste ce qu'il me fallait.

        c'est Application.Calculation = xlCalculationAutomatic
        qui permet de faire la détection automatiquement?
        0
    2. Patrice33740 Messages postés 8400 Date d'inscription   Statut Membre Dernière intervention   1 783
       
      Bonjour,

      Non, c'est l'évènement Change qui lance automatiquement l'exécution de Worksheet_Change à chaque modification du contenu d'une cellule.

      Application.Calculation = xlCalculationAutomatic rétablit les calculs qui avaient été arrêtés au début de la procédure par Application.Calculation = xlCalculationManual
      0
    3. Maksime568 Messages postés 145 Statut Membre
       
      Ok merci beaucoup.

      Comment faire un retour à la ligne dans une formule? je n'arrive pas a utiliser ici le "_ " pour continuer une formule sur une autre ligne.
      0
  2. Patrice33740 Messages postés 8400 Date d'inscription   Statut Membre Dernière intervention   1 783
     
    bonjour,

    pour faire un retour à la ligne dans le code, à l'intérieur d'une chaine de caractères, il faut découper la chaine en morceaux et concaténer les morceaux, puis mettre les retours à l'extérieur des morceaux de chaine
    Par exemple la ligne : 
    c.FormulaR1C1Local = "=SI(OU(LC(1)<>"""";LC(2)<>"""");SI(OU(LC(1)=""HS"";LC(2)=""HS"");""NOK"";""OK"");"""")"

    coupée en morceaux devient : 
    c.FormulaR1C1Local = "=SI(OU(LC(1)<>"""";" & "LC(2)<>"""");" & "SI(OU(LC(1)=""HS"";" & "LC(2)=""HS"");""NOK"";""OK"");"""")"

    puis avec les retours à la ligne : 
    c.FormulaR1C1Local = "=SI(OU(LC(1)<>"""";" & _
                     "LC(2)<>"""");" & _
                     "SI(OU(LC(1)=""HS"";" & _
                     "LC(2)=""HS"");""NOK"";""OK"");"""")"
    1
    1. Maksime568 Messages postés 145 Statut Membre
       
      encore merci, c'est parfait.
      J'ai rajouter ce dont j'avais besoin et tout est parfait.
      merci, merci, merci!!!!
      0
  3. Patrice33740 Messages postés 8400 Date d'inscription   Statut Membre Dernière intervention   1 783
     
    Bonjour,

    Je ne comprend pas la question, ce n'est ni clair, ni précis !

    Dans ton fichier les macros existantes son liées aux formulaires AJOUTER et EMBALLAGE dont tu ne parles pas.
    Mais elles n'ont aucun rapport avec les problèmes exposés !!!

    Il semblerait que tes problèmes soient simplement liés aux formules de calcul Excel et n'ont rien à voir avec le VBA !
    0
    1. Maksime568 Messages postés 145 Statut Membre
       
      Bonjour,

      Les macros AJOUTER et EMBALLAGE n'ont pas de rapport avec mes problèmes effectivement.
      Les macros à problèmes sont dans ThiwWorkbook 
      Option Explicit

      Public Sub StatutFIOoknok()
      Dim li1 As Long, li2 As Long, li As Long
      li1 = 7
      li2 = 20050
      For li = li1 To li2
        If Range("Q" & li).Value = "" Then
          Range("P" & li).Value = ""
        ElseIf Range("P" & li).Value = "HS" Then
            Range("P" & li).Value = "NOK"
          ElseIf IsNumeric(Range("P" & li).Value) Then
            Range("P" & li).Value = "OK"
      End If
      Next li
      End Sub


      Public Sub StatutFinalDPoknok()
      Dim li1 As Long, li2 As Long, li As Long
      li1 = 7
      li2 = 20050
      For li = li1 To li2
      If Range("P" & li).Value = "" Then
          Range("S" & li).Value = ""
          Else
          If Range("Q" & li).Value > 0 And Range("Q" & li).Value < 3 And Range("R" & li).Value = "" Then
              Range("S" & li).Value = "OK"
          Else
              If Range("Q" & li).Value > 0 And Range("Q" & li).Value < 10 And Range("R" & li).Value > 0 And Range("R" & li).Value < 3 Then
              Range("S" & li).Value = "OK"
              Else
                  Range("S" & li).Value = "NOK"
              End If
          End If
      End If
      Next li
      End Sub

      Public Sub StatutFinalRXetDPoknok()
      Dim li1 As Long, li2 As Long, li As Long
      li1 = 7
      li2 = 20050
      For li = li1 To li2
      If Range("I" & li).Value & Range("J" & li).Value & Range("K" & li).Value = "" And Range("S" & li).Value = "OK" Then
          Range("T" & li).Value = "OK"
          ElseIf Range("I" & li).Value & Range("J" & li).Value & Range("K" & li).Value & Range("S" & li).Value = "" Then
          Range("T" & li).Value = ""
          Else: Range("T" & li).Value = "NOK"
      End If
      Next li
      End Sub

      Public Sub prestressapresCT()
      Dim li1 As Long, li2 As Long, li As Long
      li1 = 7
      li2 = 20050
      For li = li1 To li2
      If Range("G" & li).Value <> "cyclage thermique" Then
          Range("U" & li).Value = ""
          ElseIf Range("V" & li).Value & Range("W" & li).Value = "" Then
          Range("U" & li).Value = "EN TEST"
          ElseIf Range("V" & li).Value > 0 And Range("V" & li).Value < 10 Then
          Range("U" & li).Value = "OK"
          Else: Range("U" & li).Value = "NOK"
      End If
      Next li
      End Sub
          
      Public Sub StatutDPapresCT()
      Dim li1 As Long, li2 As Long, li As Long
      li1 = 7
      li2 = 20050
      For li = li1 To li2
      If Range("U" & li).Value = "EN TEST" Then
          Range("X" & li).Value = ""
          ElseIf Range("U" & li).Value = "" Then
          Range("X" & li).Value = ""
          ElseIf Range("V" & li).Value > 0 And Range("V" & li).Value < 3 And Range("W" & li).Value = "" Then
          Range("X" & li).Value = "OK"
          ElseIf Range("V" & li).Value > 0 And Range("W" & li).Value > 0 And Range("V" & li).Value < 10 And Range("W" & li).Value < 5 Then
          Range("X" & li).Value = "OK"
          Else: Range("X" & li).Value = "NOK"
      End If
      Next li

      End Sub


      chacune de ces macros doit statuer sur le statut de chaque pièce lorsque je complète mon tableau, notamment dans les cellules Q et R.
      Les 3 premières sont les plus utilisées (pour presque toutes les pièces), les deux dernières sont uniquement pour un prélèvement de 5% de pièces repérées par "cyclage thermique" dans la cellule G.
      0
  4. Patrice33740 Messages postés 8400 Date d'inscription   Statut Membre Dernière intervention   1 783
     
    Re,

    Désolé, je n'avais pas vu ces macro.
    Comment ces macros sont-elles exécutée (il n'y a ni bouton ni évènement déclencheur) ?

    Il y a déjà des formules et un résultat dans les cellules où ces macros agissent, quel est le but recherché, est-ce d'obtenir le même résultat que les formules ?

    Si c'est le cas, le plus simple pour obtenir le même résultat est d'utiliser les mêmes conditions que dans les formules !

    Mais alors, quel est l'intérêt des macros si les formules fonctionnent ?

    Pour limiter le nombre de boucles tu peux utiliser : 
      li2 = Cells(li7, "E").End(xlDown).Row


    Il faudrait aussi suspendre l'actualisation écran, les calculs et les évènements pour accélérer l'exécution
    Cordialement
    Patrice
    0
    1. Maksime568 Messages postés 145 Statut Membre
       
      Le but serait d'obtenir le même résultats que les formules.

      Le problèmes est que je ne suis pas seul a travailler sur ce fichier.
      Parfois des lignes sont rajoutées mais si personnes ne "tire" les formules à descendre ça pose des soucis. Car mon fichier final possède plusieurs onglet dans le même genre. Ça m'éviterait de devoir surveiller ce fichier trop souvent.
      Le mieux serait d'avoir une détection du remplissage des cellules.
      0

Discussions similaires

le frigo ne marche pas....
Nemo6456 -
Templier Nocturne -

1 réponse
Excel : afficher toutes les lignes et colonnes masquées
livlarsen -
Mehdiiii -

27 réponses
Statut « en ligne » alors que non
GgBono -
Slickk -

1 réponse
Probleme d'affichage de ligne dans Excel
sammy79 -
Pierre65 -

12 réponses
remettre toutes les colonnes et les lignes masquées
mousaillon -
oumnas -

4 réponses