Sujet Précédent Sujet Suivant

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

Résolu/Fermé
Maksime568 Messages postés 144 Date d'inscription mardi 15 avril 2014 Statut Membre Dernière intervention 28 novembre 2022 - 17 avril 2015 à 10:34
Maksime568 Messages postés 144 Date d'inscription mardi 15 avril 2014 Statut Membre Dernière intervention 28 novembre 2022 - 21 avril 2015 à 13:39
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


A voir également:

4 réponses

Réponse 1 / 4
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 779
17 avril 2015 à 16:04
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
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 779
17 avril 2015 à 16:10
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
Maksime568 Messages postés 144 Date d'inscription mardi 15 avril 2014 Statut Membre Dernière intervention 28 novembre 2022 > Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023
20 avril 2015 à 14:27
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
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 779
20 avril 2015 à 14:38
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
Maksime568 Messages postés 144 Date d'inscription mardi 15 avril 2014 Statut Membre Dernière intervention 28 novembre 2022
Modifié par Maksime568 le 21/04/2015 à 13:10
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
Réponse 2 / 4
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 779
21 avril 2015 à 13:25
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
Maksime568 Messages postés 144 Date d'inscription mardi 15 avril 2014 Statut Membre Dernière intervention 28 novembre 2022
21 avril 2015 à 13:39
encore merci, c'est parfait.
J'ai rajouter ce dont j'avais besoin et tout est parfait.
merci, merci, merci!!!!
0
Réponse 3 / 4
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 779
17 avril 2015 à 11:51
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
Maksime568 Messages postés 144 Date d'inscription mardi 15 avril 2014 Statut Membre Dernière intervention 28 novembre 2022
17 avril 2015 à 12:31
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
Réponse 4 / 4
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 779
Modifié par Patrice33740 le 17/04/2015 à 14:15
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
Maksime568 Messages postés 144 Date d'inscription mardi 15 avril 2014 Statut Membre Dernière intervention 28 novembre 2022
17 avril 2015 à 14:50
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

Comment faire le symbole coeur vide/coeur blanc
Paria -
2008G.C -

60 réponses
le frigo ne marche pas....
Nemo6456 -
Templier Nocturne -

1 réponse
Que veut dire "correspondant occupé" lors d'un appel ?
veroaaa -
Pat -

10 réponses
On me voit connecté sur facebook alors que je n'y suis pas
MrTheMolode -
lily -

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

1 réponse