Problème chaine OL

**bboy-eazy** · 13/08/2014, 15h26

Bonjour,

J'ai un problème concernant la suppression d'une chaine et je n'arrive pas à résoudre le problème.

J'ai un fichier dans lequel je copie des données:

1) En feuille PETRI_1, je fais un copier/coller du programme. si les lots sont pris en contrôler, je les supprimes de cette feuille
2) Je vais dans la feuille programmation (afin de programmer les jours de contrôle et savoir ce qu'il faut préparer) et je clique sur le bouton Update afin de mettre à jour la feuille programmation, si des choses changent, cela devient rouge et si des choses sont terminées (lot pris en contrôle = oui dans feuille PETRI_1), cela disparait
3) J'ai un problème concernant la chaine nommée OL (Cf. première ligne et deuxième colonne de la feuille Programmation dans le classeur en PJ) Si cette chaine est supprimées de la feuille PETRI_1, elle reste cependant dans la feuille Programmation malgré l'update (le bouton Update lance la macro1).

Il faut savoir que la chaine OL est une chaine arrivée après la mise en place du fichier mais je ne vois pas pourquoi cette chaine ne veut pas partir comparé aux autres chaines....

Savez-vous pourquoi svp?

Merci d'avance de votre aide

voici le code du bouton update et le code de la feuille programmation:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Application.Intersect(Range("K3:K1000"), Target) Is Nothing Then
    ActiveSheet.Unprotect Password:="123456"
    Range("K13:K1000").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="lundi,mardi,mercredi,jeudi,vendredi,samedi"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, UserInterfaceOnly:=True, Password:="123456"
End If
Target.Select
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
Sub Macro1()
 
Application.ScreenUpdating = False
'Variables pour l'étape de comparaison
'i et j sont respectivement les variables de balayage des lignes pour les onglets de données source et programmation
'k est juste une variable de stockage temporaire d'une valeur de j
Dim i, j, k, n As Integer
 
' C désigne la chaine, Key la clé de recherche pour les comparaison, Q la quantité d'un lot
Dim C, Key, Secteur, Lot, Q, Statut, Z As Variant
 
'Données pour la programmation
'Remise en forme initiale de la feuille
ActiveSheet.Unprotect Password:="123456"
Columns("M:P").EntireColumn.Hidden = False
'Désactivation des filtres en cours
If ActiveSheet.AutoFilterMode = True Then
    ActiveSheet.AutoFilterMode = False
    ActiveSheet.Range("A1:P1").AutoFilter
End If
Range("A3:M1000").Select
    Selection.Font.ColorIndex = 0
    Selection.Font.Bold = False
    Range("D3:D1000,F3:F1000").Select
    Selection.Font.Bold = True
'Tri par chaine pour accélérer et fiabiliser les comparaisons
Worksheets("Programmation").Range("A3:O1000").Sort Key1:=Range("C3"), Order1:=xlAscending, Header:=xlNo, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
 
'Balayage des 3 onglets de saisie (Petri_1 --> p = 3, Petri_2, et T&F --> p = 5)
For p = 3 To 5
i = 6
j = 3
k = 3
 
'Données sources issues des programmes de production
'Tri par chaine des données dans un premier temps pour accélérer et fiabiliser les comparaisons
Worksheets(p).Activate
ActiveSheet.Unprotect Password:="123456"
Secteur = Worksheets(p).Name
'Enregistrements des filtres en place sur l'onglet avant de l'enlever pour pouvoir trier toutes les données
SaveFilters
Worksheets(p).Range("A6:P500").Sort Key1:=Range("B6"), Order1:=xlAscending, Header:=xlNo, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
 
Worksheets("Programmation").Activate
'Tant que tous les lots présents dans les données sources de chaque onglet n'ont pas été balayées
While Worksheets(p).Cells(i, 3) <> Vide
    If p < 5 Then
        Key = Worksheets(p).Cells(i, 15).Value
    Else
        Key = Worksheets(p).Cells(i, 16).Value
    End If
    'Recherche de la première ligne correspondant à la chaine cherchée
    'Recomparaison de la chaine à chaque nouveau lot (si identique, inutile de rechercher la position de la première ligne)
 
    If Worksheets(p).Cells(i, 2).Value <> C And Worksheets("Programmation").Cells(j, 3).Value <> Vide Then
        C = Worksheets(p).Cells(i, 2).Value
        While Worksheets("Programmation").Cells(j, 3).Value <> C And Worksheets("Programmation").Cells(j, 3).Value <> Vide
            j = j + 1
        Wend
        'Si la chaine est déjà dans le programme, remise à zéro des statuts de vérification pour chaque lot de cette même chaine
        If Worksheets("Programmation").Cells(j, 3).Value <> Vide Then
            Selection.AutoFilter Field:=3, Criteria1:=C
            Worksheets("Programmation").Range("O3:O1000").ClearContents
            Selection.AutoFilter Field:=3
        End If
        k = j
    Else
        C = Worksheets(p).Cells(i, 2).Value
        j = k
    End If
 
    'Tant que le lot n'a pas été trouvé et qu'on est sur la même chaine
    ' Si petri
    If p < 5 Then
        Lot = Worksheets(p).Range("E" & i).Value
        Statut = Worksheets(p).Range("L" & i).Value
        Q = Worksheets(p).Range("M" & i).Value
    ' Sinon si T&F
    Else
        Lot = Worksheets(p).Range("F" & i).Value
        Statut = Worksheets(p).Range("M" & i).Value
        Q = Worksheets(p).Range("N" & i).Value
    End If
    While Worksheets("Programmation").Cells(j, 3).Value = C And C <> Vide
        Z = Worksheets("Programmation").Cells(j, 14).Value
        If Worksheets("Programmation").Cells(j, 14).Value = Key And Worksheets("Programmation").Cells(j, 15).Value <> "O" Then
            'Mise à jour de la quantité réalisée, du N° de lot et du statut du contrôle
            Worksheets("Programmation").Range("F" & j & ":F" & j).Value = Lot
            Worksheets("Programmation").Range("G" & j & ":G" & j).Value = Q
            Worksheets("Programmation").Range("M" & j & ":M" & j).Value = Statut
            Worksheets("Programmation").Cells(j, 15).Value = "O"
            'Si trouvé, on sort de la boucle
            GoTo Suivant
        End If
        j = j + 1
    Wend
 
    'Si pas trouvé, recopie de la ligne à la suite de la liste
    If Q <> 0 Then
        n = Worksheets("Programmation").Cells(1, 16).Value + 1
        Worksheets("Programmation").Range("A" & n & ":A" & n).Value = Secteur
        ' Si petri
        If p < 5 Then
            Worksheets("Programmation").Range("B" & n & ":F" & n).Value = Worksheets(p).Range("A" & i & ":E" & i).Value
            Worksheets("Programmation").Range("G" & n & ":G" & n).Value = Worksheets(p).Range("M" & i & ":M" & i).Value
            Worksheets("Programmation").Range("H" & n & ":I" & n).Value = Worksheets(p).Range("I" & i & ":J" & i).Value
            Worksheets("Programmation").Range("K" & n & ":K" & n).Value = Worksheets(p).Range("N" & i & ":N" & i).Value
            Worksheets("Programmation").Range("M" & n & ":M" & n).Value = Worksheets(p).Range("L" & i & ":L" & i).Value
        ' Sinon si T&F
        Else
            Worksheets("Programmation").Range("B" & n & ":D" & n).Value = Worksheets(p).Range("A" & i & ":C" & i).Value
            Worksheets("Programmation").Range("E" & n & ":F" & n).Value = Worksheets(p).Range("E" & i & ":F" & i).Value
            Worksheets("Programmation").Range("G" & n & ":G" & n).Value = Worksheets(p).Range("N" & i & ":N" & i).Value
            Worksheets("Programmation").Range("H" & n & ":I" & n).Value = Worksheets(p).Range("J" & i & ":K" & i).Value
            Worksheets("Programmation").Range("K" & n & ":K" & n).Value = Worksheets(p).Range("O" & i & ":O" & i).Value
            Worksheets("Programmation").Range("M" & n & ":M" & n).Value = Worksheets(p).Range("M" & i & ":M" & i).Value
        End If
        Worksheets("Programmation").Range("O" & n & ":O" & n).Value = "O"
 
        'Faire apparaître les nouveaux lots ou lots modifiés pour les reconnaitre facilement et faire la programmation
        Worksheets("Programmation").Range("A" & n & ":M" & n).Select
            Selection.Font.ColorIndex = 3
            Selection.Font.Bold = True
    End If
Suivant:
i = i + 1
Wend
 
'Si il n'y a aucune données dans les onglets sources, supprimer tous les lots relatifs au secteur
If i = 6 Then
    While Worksheets("Programmation").Cells(j, 3).Value <> Vide
        If Worksheets("Programmation").Cells(j, 1).Value = Secteur Then
            Worksheets("Programmation").Range("O" & j & ":O" & j).ClearContents
        End If
    j = j + 1
    Wend
End If
 
'Reclassement par semaine dans les feuilles de saisie des données source pour rendre les données plus lisible
Worksheets(p).Activate
Worksheets(p).Range("A6:P500").Sort Key1:=Range("I6"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
' Si petri
If p < 5 Then
    Worksheets(p).Range("A6:K500").Interior.ColorIndex = 36
Else
    Worksheets(p).Range("A6:L500").Interior.ColorIndex = 36
End If
Worksheets(p).Range("A6:K500").Select
With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlMedium
    .ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlMedium
    .ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlMedium
    .ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlMedium
    .ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With
Range("A4").Select
RestoreFilters
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, UserInterfaceOnly:=True, Password:="123456"
 
Next p
 
'Suppression des lots qui n'ont pas été retrouvés ou pour lesquels on aucune boite n'a été produite
Worksheets("Programmation").Activate
Selection.AutoFilter Field:=15, Criteria1:="="
Worksheets("Programmation").Range("A3:M1001").ClearContents
Selection.AutoFilter Field:=15
Selection.AutoFilter Field:=7, Criteria1:="=0"
Worksheets("Programmation").Range("A3:M1001").ClearContents
Worksheets("Programmation").Range("O3:O1001").ClearContents
Selection.AutoFilter Field:=7
 
'Tri des données par date puis par type de produit
Worksheets("Programmation").Range("A3:O1000").Sort Key1:=Range("H3"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Worksheets("Programmation").Range("A3:O1000").Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Columns("N:P").EntireColumn.Hidden = True
'Remise en forme de la feuille
ActiveSheet.Unprotect Password:="123456"
Range("A3:M1000").FormatConditions.Delete
Range("A3:M1000").Interior.ColorIndex = xlNone
For i = 4 To 1000
    Range("A" & i & ":M" & i).Interior.ColorIndex = 15
i = i + 1
Next i
 
Worksheets("Programmation").Range("A2").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, UserInterfaceOnly:=True, Password:="123456"
 
End Sub

PS:

Problème chaine OL

Macros et VBA Excel

Mode arborescent

Discussions similaires

Partager

Partager