Alléger mon code
re-Bonjour!
J'ai un fichier assez gros que j'ai réalisé pour un projet, malheureusement étant novice j'ai fais un peu cela comme j'ai pu mais désormais je rencontre un problème.
Une de mes procédure est trop grande.
C'est celle qui est dans "Feuil(Résultats)".
Elle sert, pour chaque case du tableau de la feuille résultats, à chercher dans liste des mesures de la feuille demande, la demande qui correspond (en fonction de la machine et du type de mesure) et d'agir sur elle quand on, affecte "terminé" dans la case du tableau., (faire passer dans les pièces terminées)...etc
Mais pour l'instant j'ai répété le code pour chaque case...
Avez vous un moyen d’alléger cette procédure?
Merci d'avance pour votre temps!
Bonjour
J'ai commencé à alléger un peu ton code, il me reste des choses à voir mais c'est déjà un bon début:
Private Sub Worksheet_Change(ByVal Target As Range) 'Quand la feuille (Worksheet) change, ce programme se lance
Dim Y As Integer, i As Integer, x As Double, n As Integer, l As Integer
If Not Intersect(Target, Range("j7", "p9")) Is Nothing Then
'Call Cloche
If ActiveCell.Value = "Terminé" Then 'Si RAS la cellule devient verte
ActiveCell.Font.ColorIndex = 51
ActiveCell.Interior.Color = RGB(50, 200, 100)
End If
For Each Cell In Range("J7:P10")
If Cell.Value = "" Then 'Enleve la couleur des cellules vides
Cell.Interior.Color = xlColorIndexNone
End If
Next Cell
Y = Sheets("Demande").Range("N" & Rows.Count).End(xlUp).Row + 1
Select Case Target.Column 'on a déjà vérifié que c'était entre les lignes 7 et 9 donc on check
'juste la colonne
Case 10
Call HeureJ9
Case 11
Call HeureK9
Case 12
Call HeureK9
Case 13
Call HeureM9
Case 14
Call HeureN9
Case 15
Call HeureO9
Case 16
Call HeureP9
End Select
For i = 4 To 20
If Sheets("Demande").Range("G" & i).Value = 600 And Sheets("Demande").Range("C" & i).Value = "PSP" Then 'On cherche les pièces de la machine à mesurer
Sheets("Demande").Range("K" & Y).Value = Sheets("Demande").Range("A" & i).Value 'Transmet les données vers les pièces terminées
Sheets("Demande").Range("L" & Y).Value = Sheets("Demande").Range("B" & i).Value
Sheets("Demande").Range("M" & Y).Value = Sheets("Demande").Range("C" & i).Value
Sheets("Demande").Range("N" & Y).Value = Sheets("Demande").Range("D" & i).Value
Sheets("Demande").Range("P" & Y).Value = Format(Time, "h:mm;@")
Sheets("Demande").Range("P" & Y).Value = Sheets("Demande").Range("H" & i).Value
Sheets("Demande").Range("V" & Y).Value = Sheets("Demande").Range("G" & i).Value
Sheets("Demande").Range("R" & Y).Value = Format(Time, "h:mm;@")
Sheets("Demande").Range("R" & Y).Value = Sheets("Demande").Range("I" & i).Value
Sheets("Demande").Range("O" & Y).Value = Sheets("Demande").Range("E" & i).Value
Sheets("Demande").Range("Q" & Y).Value = Format(Time, "h:mm;@") 'La cellule L4 devient l'heure
Sheets("Demande").Range("S" & Y).Value = Format(Time, "h:mm;@") ' pour donner un format à la cellule avant d'y écrire
Sheets("Demande").Range("S" & Y) = CDate(Sheets("Demande").Range("Q" & Y)) - CDate(Sheets("Demande").Range("H" & i)) 'Temps pris pour mesurer
x = CDate(Sheets("Demande").Range("I" & i)) - CDate(Sheets("Demande").Range("S" & Y)) 'Compare le temps mis au temps attendu
If x > 0 Then
Sheets("Demande").Range("T" & Y).Value = "Avance"
ElseIf x < 0 Then
Sheets("Demande").Range("T" & Y).Value = "Retard"
x = -x
End If
Sheets("Demande").Range("U" & Y).Value = Format(Time, "h:mm;@") 'Donne un format à la cellule
Sheets("Demande").Range("U" & Y).Value = x 'Prend la vameur de l'écart entre temps attendu et temps mis
If Sheets("Demande").Range("T" & Y).Value = "Retard" Then
Retard.Show
Sheets("Demande").Range("W" & Y) = w
End If
Y = Sheets("Demande").Range("N3").End(xlDown).Row + 1
For n = i + 1 To i + 10
If Sheets("Demande").Range("B" & n).Value <> "" Then GoTo 1
If Sheets("Demande").Range("D" & n).Value <> "" Then
Sheets("Demande").Rows(Y).Locked = False
Sheets("Demande").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True
Sheets("Demande").Range("N" & Y).Value = Sheets("Demande").Range("D" & n).Value
Sheets("Demande").Range("O" & Y).Value = Sheets("Demande").Range("E" & n).Value
Sheets("Demande").Range("D" & n).ClearContents
Sheets("Demande").Range("E" & n).ClearContents
Y = Y + 1
End If
Next n
Sheets("Demande").Range("B" & i).ClearContents 'Vide les pièces à mesurer
Sheets("Demande").Range("C" & i).ClearContents
Sheets("Demande").Range("D" & i).ClearContents
Sheets("Demande").Range("E" & i).ClearContents
Sheets("Demande").Range("A" & i).ClearContents
Sheets("Demande").Range("F" & i).ClearContents
Sheets("Demande").Range("G" & i).ClearContents
Sheets("Demande").Range("H" & i).ClearContents
Sheets("Demande").Range("I" & i).ClearContents
End If
Next i
End If
End SubMerci de ton travail!
Il y a deux choses:
- Si tu différencie uniquement en fonction de la colonne, comment tu saura si il faut enlever la mesure (600-PSP) ou la mesure (600-Réglage)?
- Le code que tu as envoyé concerne uniquement la machine 600 ou les sept machines?
Re,
En effet je n'avais pas vu qu'une de tes ligne variait
Pour info: j'ai remplacé toute ta suite de test pour savoir si tu appelais HeuresJ9, HeuresO9 etc... par
Cells(10, Target.Column) = Format(Time, "h\Hmm")J'ai utilisé un With Sheets("Demande") pour enlever tous les Sheets("Demande") de ton code, j'ai enlevé les .Value que tu mettais partout car ils ne sont pas nécessaires, ton clear content à la fin est remplacé par :
.Range("A" & i, "I" & i).ClearContents 'Vide les pièces à mesurerqui fait le même job.
J'ai également remplacé les valeurs fixes pour le test par des valeurs qui varient en fonction de la ligne et de la colonne de la cellule qui a été modifiée avec :
Cells(6, Target.Column)et
Range("i" & Target.Row)En clair la cellule ligne 6 qui se trouve à la même colonne que Target pour la machine, et la cellule colonne I qui se trouve à la même ligne que Target.
Le code final devrait être:
Private Sub Worksheet_Change(ByVal Target As Range) 'Quand la feuille (Worksheet) change, ce programme se lance
Dim Y As Integer, i As Integer, x As Double, n As Integer, l As Integer
If Not Intersect(Target, Range("j7", "p9")) Is Nothing Then
'Call Cloche
If ActiveCell.Value = "Terminé" Then 'Si RAS la cellule devient verte
ActiveCell.Font.ColorIndex = 51
ActiveCell.Interior.Color = RGB(50, 200, 100)
End If
For Each Cell In Range("J7:P10")
If Cell.Value = "" Then 'Enleve la couleur des cellules vides
Cell.Interior.Color = xlColorIndexNone
End If
Next Cell
Y = Sheets("Demande").Range("N" & Rows.Count).End(xlUp).Row + 1
Cells(10, Target.Column) = Format(Time, "h\Hmm")
For i = 4 To 20
With Sheets("Demande")
If .Range("G" & i) = Cells(6, Target.Column) And .Range("C" & i) = Range("i" & Target.Row) Then 'On cherche les pièces de la machine à mesurer
.Range("K" & Y) = .Range("A" & i) 'Transmet les données vers les pièces terminées
.Range("L" & Y) = .Range("B" & i)
.Range("M" & Y) = .Range("C" & i)
.Range("N" & Y) = .Range("D" & i)
.Range("P" & Y) = Format(Time, "h:mm;@")
.Range("P" & Y) = .Range("H" & i)
.Range("V" & Y) = .Range("G" & i)
.Range("R" & Y) = Format(Time, "h:mm;@")
.Range("R" & Y) = .Range("I" & i)
.Range("O" & Y) = .Range("E" & i)
.Range("Q" & Y) = Format(Time, "h:mm;@") 'La cellule L4 devient l'heure
.Range("S" & Y) = Format(Time, "h:mm;@") ' pour donner un format à la cellule avant d'y écrire
.Range("S" & Y) = CDate(.Range("Q" & Y)) - CDate(.Range("H" & i)) 'Temps pris pour mesurer
x = CDate(.Range("I" & i)) - CDate(.Range("S" & Y)) 'Compare le temps mis au temps attendu
If x > 0 Then
.Range("T" & Y) = "Avance"
ElseIf x < 0 Then
.Range("T" & Y) = "Retard"
x = -x
End If
.Range("U" & Y) = Format(Time, "h:mm;@") 'Donne un format à la cellule
.Range("U" & Y) = x 'Prend la vameur de l'écart entre temps attendu et temps mis
If .Range("T" & Y) = "Retard" Then
Retard.Show
.Range("W" & Y) = w
End If
Y = .Range("N3").End(xlDown).Row + 1
For n = i + 1 To i + 10
If .Range("B" & n) <> "" Then GoTo 1
If .Range("D" & n) <> "" Then
.Rows(Y).Locked = False
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True
.Range("N" & Y) = .Range("D" & n)
.Range("O" & Y) = .Range("E" & n)
.Range("D" & n).ClearContents
.Range("E" & n).ClearContents
Y = Y + 1
End If
Next n
.Range("A" & i, "I" & i).ClearContents 'Vide les pièces à mesurer
End With
End If
Next i
End If
End SubTu pourras supprimer tous tes programmes "Heure" comme je ne les utilise plus, à moins que tu les utilises ailleurs...
Tu me diras si tout fonctionne
Merci pour tout! Et merci de m'expliquer car je comprend ce que tu as fais et c'est important
Cependant je ne comprend toujours pas comment le programme va chercher sur la feuille résultats les mesures correspondantes?
Re
Est-ce que tu parles de cette ligne de code?
If .Range("G" & i) = Cells(6, Target.Column) And .Range("C" & i) = Range("i" & Target.Row) Then Si tu me précises où ça se trouve je pourrai t'expliquer ou bien reprendre le code car je passe peut-être à côté de quelque chose, comme ton code était massif je n'ai pas analysé ligne par ligne ce qui changeait
En tout cas si c'est bien cette ligne de code, la mesure correspondante se trouve colonne I dans la feuille de résultat, il suffit ensuite de voir sur quelle ligne la modification a été faite pour savoir de quelle mesure il s'agit, ce qui donne: Range("i" & Target.Row), cellule colonne I, sur la ligne où a eu lieu la modification
Ce que je veux dire c'est que quand on met terminé dans une case de la feuille "Résultats", par exemple la 600-PSP, et bien ça doit faire une recherche dans la feuille "demande" pour agir sur toutes les mesures 600-PSP, et je ne comprenait pas comment ton code pouvait prendre cela en compte
Ce que je veux dire c'est que quand on met terminé dans une case de la feuille "Résultats", par exemple la 600-PSP, et bien ça doit faire une recherche dans la feuille "demande" pour agir sur toutes les mesures 600-PSP, et je ne comprenait pas comment ton code pouvait prendre cela en compte
Ah d'accord, ça veut dire que tu ne comprends pas la toute première ligne du code qui est:
Private Sub Worksheet_Change(ByVal Target As Range)En fait ton code reçois une variable en entrée qui est de type Range, il s'agit de la plage de cellules qui est modifiée au moment où ce code se lance, tu peux donc savoir sur quelle ligne, colonne, la modification est faite en utilisant Target.Row et Target.Column.
Pour ne traiter que les lignes 600-PSP, j'ai astucieusement changé cette ligne:
If Sheets("Demande").Range("G" & i).Value = 600 And Sheets("Demande").Range("C" & i).Value = "PSP" Then En quelque chose de variable, le 600, tu peux le retrouver sur la cellule J6, donc sur la colonne où tu as mis "Terminé", à la ligne 6: Cells(6, Target.Column), quand au PSP, il s'agit de l'information dans la cellule I7, dans la colonne I à la ligne où tu as mis "Terminé": Range("I" a Target.Row).
C'est l'utilisation de ces valeurs qui me permet de rendre tout ça variable et donc d'utiliser cette ligne d'instruction peu importe la cellule sur laquelle tu mets "Terminé"
Ah d'accord! Je n'avais pas compris, c'est fou que tu arrive a faire en une page ce que je faisais en vingt
J'ai mis ce que tu m'avais donné dans mon programme mais ça me dit qu'il y a un end with sans with.. pourtant je le vois le with je suis pas fou
Je me suis dit que c’était peut être une boucle qui n'était pas fermée mais après vérification ce n'est pas cela non plus
Re!
C'est parce que j'avais inversé le End If avec le End With, je n'avais pas testé le code, c'est pour ça que tu as eu ce souci
J'ai aussi remplacé ton goto 1 par un simple exit for, comme le but recherché est le même, celui de sortir de la boucle
Le résultat final est le suivant:
J'en ai profité pour enlevé tous les programmes HeureJ9 etc.
Le code final est:
Private Sub Worksheet_Change(ByVal Target As Range) 'Quand la feuille (Worksheet) change, ce programme se lance
Dim Y As Integer, i As Integer, x As Double, n As Integer, l As Integer
If Not Intersect(Target, Range("j7", "p9")) Is Nothing Then
'Call Cloche
If ActiveCell.Value = "Terminé" Then 'Si RAS la cellule devient verte
ActiveCell.Font.ColorIndex = 51
ActiveCell.Interior.Color = RGB(50, 200, 100)
End If
For Each Cell In Range("J7:P10")
If Cell.Value = "" Then 'Enleve la couleur des cellules vides
Cell.Interior.Color = xlColorIndexNone
End If
Next Cell
Y = Sheets("Demande").Range("N" & Rows.Count).End(xlUp).Row + 1
Cells(10, Target.Column) = Format(Time, "h\Hmm")
For i = 4 To 20
With Sheets("Demande")
If .Range("G" & i) = Cells(6, Target.Column) And .Range("C" & i) = Range("i" & Target.Row) Then 'On cherche les pièces de la machine à mesurer
.Range("K" & Y) = .Range("A" & i) 'Transmet les données vers les pièces terminées
.Range("L" & Y) = .Range("B" & i)
.Range("M" & Y) = .Range("C" & i)
.Range("N" & Y) = .Range("D" & i)
.Range("P" & Y) = Format(Time, "h:mm;@")
.Range("P" & Y) = .Range("H" & i)
.Range("V" & Y) = .Range("G" & i)
.Range("R" & Y) = Format(Time, "h:mm;@")
.Range("R" & Y) = .Range("I" & i)
.Range("O" & Y) = .Range("E" & i)
.Range("Q" & Y) = Format(Time, "h:mm;@") 'La cellule L4 devient l'heure
.Range("S" & Y) = Format(Time, "h:mm;@") ' pour donner un format à la cellule avant d'y écrire
.Range("S" & Y) = CDate(.Range("Q" & Y)) - CDate(.Range("H" & i)) 'Temps pris pour mesurer
x = CDate(.Range("I" & i)) - CDate(.Range("S" & Y)) 'Compare le temps mis au temps attendu
If x > 0 Then
.Range("T" & Y) = "Avance"
ElseIf x < 0 Then
.Range("T" & Y) = "Retard"
x = -x
End If
.Range("U" & Y) = Format(Time, "h:mm;@") 'Donne un format à la cellule
.Range("U" & Y) = x 'Prend la vameur de l'écart entre temps attendu et temps mis
If .Range("T" & Y) = "Retard" Then
Retard.Show
.Range("W" & Y) = w
End If
Y = .Range("N3").End(xlDown).Row + 1
For n = i + 1 To i + 10
If .Range("B" & n) <> "" Then Exit For
If .Range("D" & n) <> "" Then
.Rows(Y).Locked = False
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True
.Range("N" & Y) = .Range("D" & n)
.Range("O" & Y) = .Range("E" & n)
.Range("D" & n).ClearContents
.Range("E" & n).ClearContents
Y = Y + 1
End If
Next n
.Range("A" & i, "I" & i).ClearContents 'Vide les pièces à mesurer
End If
End With
Next i
End If
End SubMerci de ton travail! Ça m'aide énormément!
En réalisant une demande de mesure j'ai obtenu cette erreur:
Bonjour,
visiblement cette fois ça venait de ton code
apparemment VBA n'aimait pas que tu fasses une conversion de date - une autre conversion de date... du coup j'ai fait la différence des 2 valeurs que j'ai ensuite convertis en date, et ça marche
J'ai mis:
.Range("S" & Y) = CDate(.Range("Q" & Y) - .Range("H" & i)) 'Temps pris pour mesureret
x = CDate(.Range("I" & i) - .Range("S" & Y)) 'Compare le temps mis au temps attenduFichier corrigé:
Ah oui effectivement petite erreur de ma part
Tout marche top! Il y a juste un dernier truc, c'est que si je fais une demande de 600-PSP, puis une mesure de 600-Réglage, ça fait comme si la 600 PSP était terminée.
A mon avis, ça vient du fait qu'il y a "en cours" qui s'affiche dans la case mais pas" terminé".
Re,
je pense qu'il s'agit encore d'une erreur dans le code
tu ne contrôles que la valeur de la cellule active soit égale à terminée que pour de la mise en forme, et tu prends activecell, qui n'est pas forcément la même cellule que celle qui vient d'être modifiée (VBA n'a pas besoin de sélectionner une cellule pour la modifier, activecell peut ne pas renvoyer la cellule qui vient d'être modifiée.
Du coup ça demande quelque corrections:
remplacer activecell par Target, ne suivre le programme que si la valeur de la cellule est égale à "Terminé"
J'ai aussi rajouté une condition à ton début de programme car apparemment tu fais une modification qui modifie 4 cellules à un moment, si le nombre de cellules modifiées est supérieur à 1, la macro ne va pas plus loin, j'ai mis:
If Target.Count > 1 Then Exit SubVoici le résultat:
Merci de ton travail! C'est vraiment super! je vais regarder tout cela plus en profondeur cet après midi! merci!
De rien
Tu me diras si tu as à nouveau des bugs, c'est possible que j'ai fait des modifications un peu à la va vite sans prendre en compte le fonctionnement global de ton fichier
J'ai regardé et il me reste un problème que j'ai identifié, dans le tableau il y a une colonne "Autre" qui correspond dans les demandes à la "méthode" ou la "qualité". Donc les mesures concernées ne s’enlèvent pas...
Tu penses que je suis obligé de rajouté une ligne au tableau? J'aimerais vraiment éviter de prendre trop de place pour des demandes méthodes ou qualité qui sont très rares...
Ou alors je met "autre" dans les demandes aussi...
Tu vois une autre solution?
Re,
Hmm je pense qu'il faudrait normalement rajouter méthode et qualité, mais je peux faire en sorte que "autre" soit équivalent à méthode et qualité dans mon code, il faut que je regarde comment modifier tout ça, si tu me donnes le feu vert.
Ce serrait parfait oui
J'ai fait la modification en question:
Mais ça rentre encore en collision avec un autre des tes programme qui se trouve dans la feuille Demande, comme tu modifies la feuille pour déplacer des informations, ça passe le statut "terminé" de la cellule en "en cours".
Je te laisse voir pourquoi