Discussion :

[bboy-eazy]

Bonjour,

J'ai un fichier excel servant à lister une série de souches bactériennes à préparer pour pouvoir contrôler le produit (c'est une référence)

J'ai un problème concernant une souche et je ne comrpends pas pourquoi. pour une référence (ici D1076) j'ai deux souches à préparer. Les deux souches sont bien présentes dans mon tableau croisée dynamique de l'onglet exploitation. Le problème c'est que dans la feuille programme souchier, seule une apparait et l'autre non....

J'ai fait des tests et si je change le jour de pris en contrôle, les 2 souches apparaissent. Du coup j'ai essayé en mettant que cette référence au meme jour de pris en contrôle pour voir si cette fois les souches apparaissent et cette fois oui quand il n'y a que la référence. J'ai donc pensé à un blocage des lignes car il y avait bcp de souches à préparer du coup ca bloque à 41 lignes apparemment.

j'ai voulu regarder le code de plus près mais je ne vois aucun blocage.... auriez-vous une idée?

voici le code de la feuille programme souchier:

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
Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
ActiveSheet.Unprotect Password:="123456"
 
Range("B7:B66,D7:D66,F7:F66,H7:H66,J7:J66,J7:J66,L7:L66,N7:N66").ClearContents
Range("B73:B150,D73:D150,F73:F150,H73:H150,J73:J150,L73:L150,N73:N150").ClearContents
Worksheets("Exploitation").Unprotect Password:="123456"
Worksheets("Exploitation").PivotTables("Tableau croisé dynamique2").RefreshTable
Worksheets("Exploitation").PivotTables("Tableau croisé dynamique1").RefreshTable
Worksheets("Exploitation").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, UserInterfaceOnly:=True, Password:="123456"
 
'Variables de balayage onglet "Exploitation
Dim i, j, k, l, n, o, p, Nombre As Integer
Dim Ref, Souche, Designation, Temps, Jour, NumJour As Variant
Dim Devis As Boolean
i = 6
k = 6
 
While Worksheets("Exploitation").Cells(i, 11).Value <> Vide
    Ref = Worksheets("Exploitation").Cells(i, 11).Value
    If Left(Ref, 1) = "d" Or Left(Ref, 1) = "D" Then
            Devis = True
    End If
    'Recherche du jour de planification de l'ensemensement
    For l = 12 To 17
        If Worksheets("Exploitation").Cells(i, l).Value > 0 Then
            Jour = Worksheets("Exploitation").Cells(5, l).Value
            'Détermination du N° de colonne où écrire le résultat
            n = (l - 11) * 2
            p = 1
            'On recopie la ref autant de fois qu'il y a de lot
            While Worksheets("Exploitation").Cells(i, l).Value >= p
                'Détermination du nombre de ligne déjà rempli au jour en question
                o = Cells(6, n).Value
                'Ecriture de la ref
                Cells(7 + o, n).Value = Ref
                p = p + 1
            Wend
        End If
    Next l
 
    'Recherche de la ref dans la liste des souches pour voir s'il y a une pré-culture à préparer
    While (Worksheets("Exploitation").Cells(k, 3).Value <> Vide Or Worksheets("Exploitation").Cells(k, 2).Value = Vide) And Worksheets("Exploitation").Cells(k, 2).Value <= Ref
        If Worksheets("Exploitation").Cells(k, 2).Value = Ref Or (Devis = True And Right(Ref, 4) = Right(Worksheets("Exploitation").Cells(k, 2), 4)) Then
            'Si ref trouvée
            j = k
            While Worksheets("Exploitation").Cells(j, 2).Value = Vide Or Worksheets("Exploitation").Cells(j, 2).Value = Worksheets("Exploitation").Cells(j + 1, 2).Value Or j = k
                Souche = Worksheets("Exploitation").Cells(j, 3).Value
                Designation = Worksheets("Exploitation").Cells(j, 4).Value
                Temps = Worksheets("Exploitation").Cells(j, 5).Value
                For l = 12 To 17
                    If Worksheets("Exploitation").Cells(i, l).Value > 0 Then
                        Jour = Worksheets("Exploitation").Cells(5, l).Value
                        If Jour = "lundi" Then
                            NumJour = 1
                        ElseIf Jour = "mardi" Then
                            NumJour = 2
                        ElseIf Jour = "mercredi" Then
                            NumJour = 3
                        ElseIf Jour = "jeudi" Then
                            NumJour = 4
                        ElseIf Jour = "vendredi" Then
                            NumJour = 5
                        ElseIf Jour = "samedi" Then
                            NumJour = 6
                        Else
                            NumJour = 7
                        End If
                        NumJour = NumJour - Application.RoundUp(Worksheets("Exploitation").Cells(j, 5).Value / 24, 0)
                        'Détermination du N° de colonne où écrire le résultat
                        If NumJour > 0 Then
                            n = (l - Application.RoundUp(Worksheets("Exploitation").Cells(j, 5).Value / 24, 0) - 11) * 2
                        Else
                            n = (7 + NumJour) * 2
                        End If
                        Q = Cells(72, n).Value
                        Cells(73 + Q, n).Value = Souche & " " & Designation & " - " & Temps & "h"
                    End If
                Next l
            j = j + 1
            Wend
            GoTo Suivant
        End If
    k = k + 1
    Wend
Suivant:
Devis = False
i = i + 1
Wend
 
'Suppression des souches en doublon
For n = 1 To 7
Range(Cells(73, n * 2), Cells(150, n * 2)).Sort Key1:=Range(Cells(73, n * 2).Address), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
i = 73
Nombre = Cells(72, n * 2)
    For i = 73 To 72 + Nombre
        Souche = Cells(i, n * 2).Value
        j = i + 1
        If Souche <> Vide Then
        While Souche = Cells(j, n * 2).Value And i <= 72 + Nombre
            Cells(j, n * 2).ClearContents
        j = j + 1
        Wend
        End If
    Next i
Range(Cells(73, n * 2), Cells(150, n * 2)).Sort Key1:=Range(Cells(73, n * 2).Address), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Next n
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, UserInterfaceOnly:=True, Password:="123456"
End Sub

voici le classeur en PJ si ca peut aider:

la précédure est la suivante:
feuille programmation colonne L: on met les jours où on veut prendre la référence en contrôle
feuille exploitation : tableau coirsée dynamique avec les références et les souches associées et les temps d'incubation des souches
feuille programme souchier ensemencement: les références apparaissent dans planning ensemencement et les souches a préparer apparaissent dans la partie planning préparation préculture (ligne 67)

dans l'exemple ci joitn on voit qu'il manque une souche de la référence D1076 dans la colonne du lundi (ATCC 15521/COS/Ana/33-37/c02)

j'espère avoir été clair