Choix uniquement par rapport à plusieurs lignes

**Oliv53** · 23/01/2015, 19h28

Bonjour,

Je dispose de plusieurs articles (colonne A) associés à une référence (colonne B), je dois détruire, conserver ou en réaliser une analyse, tout en sachant que mes articles sont sur plusieurs lignes suivant l’utilisation faite.
J’ai des dates de débuts et fin d’utilisation (colonne C, E), des classes qui utilisent l’article (colonne D).

J’ai réussi à écrire la macro pour une décision sur une ligne (colonne F) mais je n’arrive pas à trouver l'astuce pour ne garder qu’une seule décision par article (colonne G) sachant que mon ordre de priorité est bien sur conserver, analyser, destruction.
La Règle est la suivante :
Analyse = absente de référence (col. A) dans ce cas il existe toujours qu’une seule ligne pour un article.
Destruction = je détermine dans ma macro la liste des classes à détruire (col. D)
Destruction = date début et/ou date fin utilisation supérieures à 10 ans (format 20150123)
Conserver = article qui ne réponds pas aux conditions ci-dessus
« Un petit coup de pouce » SVP

**(WOLF)** · 24/01/2015, 01h46

Bonjour, je suis prêt à aider mais il me faut le fichier original pour pouvoir travailler dessus et des réponses à toutes les questions que je vous poserez.

**Oliv53** · 24/01/2015, 18h23

Bonjour WOLF, merci d'accepter de m'aider. Je te donne le fichier, il est simplifié car l'original est volumineux et professionnel.
forum.xlsx
voici la macro qe j'ai écrite :

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
Sub RECH_UTIL2()
 
    For ligne = 2 To 33
 
' liste des article analyser
        If Cells(ligne, 2) Like "" Then
        Cells(ligne, 6).Value = "analyse"
' liste des anciennes classes vehicules
         ElseIf Cells(ligne, 4) Like "*" & "_1CN6" & "*" Then
        Cells(ligne, 6).Value = "destruction"
         ElseIf Cells(ligne, 4) Like "*" & "_1CS8" & "*" Then
        Cells(ligne, 6).Value = "destruction"
         ElseIf Cells(ligne, 4) Like "*" & "_1CU6" & "*" Then
        Cells(ligne, 6).Value = "destruction"
         ElseIf Cells(ligne, 4) Like "*" & "_1CV8" & "*" Then
        Cells(ligne, 6).Value = "destruction"
         ElseIf Cells(ligne, 4) Like "*" & "_1CX1" & "*" Then
        Cells(ligne, 6).Value = "destruction"
         ElseIf Cells(ligne, 4) Like "*" & "_1PN3" & "*" Then
        Cells(ligne, 6).Value = "destruction"
'liste des années et mois à plus de 10 annees en date fin
        ElseIf Cells(ligne, 5) Like "*" & "198" & "*" Then
                Cells(ligne, 6).Value = "destruction"
        ElseIf Cells(ligne, 5) Like "*" & "199" & "*" Then
                Cells(ligne, 6).Value = "destruction"
        ElseIf Cells(ligne, 5) Like "*" & "2000" & "*" Then
                Cells(ligne, 6).Value = "destruction"
        ElseIf Cells(ligne, 5) Like "*" & "2001" & "*" Then
                Cells(ligne, 6).Value = "destruction"
        ElseIf Cells(ligne, 5) Like "*" & "2002" & "*" Then
                Cells(ligne, 6).Value = "destruction"
        ElseIf Cells(ligne, 5) Like "*" & "2003" & "*" Then
                Cells(ligne, 6).Value = "destruction"
        ElseIf Cells(ligne, 5) Like "*" & "2004" & "*" Then
                Cells(ligne, 6).Value = "destruction"
        ElseIf Cells(ligne, 5) Like "*" & "200501" & "*" Then
                Cells(ligne, 6).Value = "destruction"
'liste des années et mois à plus de 10 annees en date debut
        ElseIf Cells(ligne, 3) Like "*" & "198" & "*" Then
                Cells(ligne, 6).Value = "destruction"
    ElseIf Cells(ligne, 3) Like "*" & "199" & "*" Then
                Cells(ligne, 6).Value = "destruction"
    ElseIf Cells(ligne, 3) Like "*" & "2000" & "*" Then
                Cells(ligne, 6).Value = "destruction"
    ElseIf Cells(ligne, 3) Like "*" & "2001" & "*" Then
                Cells(ligne, 6).Value = "destruction"
    ElseIf Cells(ligne, 3) Like "*" & "2002" & "*" Then
                Cells(ligne, 6).Value = "destruction"
    ElseIf Cells(ligne, 3) Like "*" & "2003" & "*" Then
                Cells(ligne, 6).Value = "destruction"
    ElseIf Cells(ligne, 3) Like "*" & "2004" & "*" Then
                Cells(ligne, 6).Value = "destruction"
    ElseIf Cells(ligne, 3) Like "*" & "200501" & "*" Then
                Cells(ligne, 6).Value = "destruction"
    Else
           Cells(ligne, 6).Value = "conserver"
 
 
        End If
 
    Next
End Sub

**(WOLF)** · 24/01/2015, 20h32

Remplacez votre code par celui ci-dessous et lancez votre macro RECH_UTIL2

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
Sub RECH_UTIL2()
 
    For ligne = 2 To 33
 
        ' liste des article analyser
        If Cells(ligne, 2) Like "" Then
            Cells(ligne, 6).Value = "analyse"
            ' liste des anciennes classes vehicules
        ElseIf Cells(ligne, 4) Like "*" & "_1CN6" & "*" Then
            Cells(ligne, 6).Value = "destruction"
        ElseIf Cells(ligne, 4) Like "*" & "_1CS8" & "*" Then
            Cells(ligne, 6).Value = "destruction"
        ElseIf Cells(ligne, 4) Like "*" & "_1CU6" & "*" Then
            Cells(ligne, 6).Value = "destruction"
        ElseIf Cells(ligne, 4) Like "*" & "_1CV8" & "*" Then
            Cells(ligne, 6).Value = "destruction"
        ElseIf Cells(ligne, 4) Like "*" & "_1CX1" & "*" Then
            Cells(ligne, 6).Value = "destruction"
        ElseIf Cells(ligne, 4) Like "*" & "_1PN3" & "*" Then
            Cells(ligne, 6).Value = "destruction"
            'liste des années et mois à plus de 10 annees en date fin
        ElseIf Cells(ligne, 5) Like "*" & "198" & "*" Then
            Cells(ligne, 6).Value = "destruction"
        ElseIf Cells(ligne, 5) Like "*" & "199" & "*" Then
            Cells(ligne, 6).Value = "destruction"
        ElseIf Cells(ligne, 5) Like "*" & "2000" & "*" Then
            Cells(ligne, 6).Value = "destruction"
        ElseIf Cells(ligne, 5) Like "*" & "2001" & "*" Then
            Cells(ligne, 6).Value = "destruction"
        ElseIf Cells(ligne, 5) Like "*" & "2002" & "*" Then
            Cells(ligne, 6).Value = "destruction"
        ElseIf Cells(ligne, 5) Like "*" & "2003" & "*" Then
            Cells(ligne, 6).Value = "destruction"
        ElseIf Cells(ligne, 5) Like "*" & "2004" & "*" Then
            Cells(ligne, 6).Value = "destruction"
        ElseIf Cells(ligne, 5) Like "*" & "200501" & "*" Then
            Cells(ligne, 6).Value = "destruction"
            'liste des années et mois à plus de 10 annees en date debut
        ElseIf Cells(ligne, 3) Like "*" & "198" & "*" Then
            Cells(ligne, 6).Value = "destruction"
        ElseIf Cells(ligne, 3) Like "*" & "199" & "*" Then
            Cells(ligne, 6).Value = "destruction"
        ElseIf Cells(ligne, 3) Like "*" & "2000" & "*" Then
            Cells(ligne, 6).Value = "destruction"
        ElseIf Cells(ligne, 3) Like "*" & "2001" & "*" Then
            Cells(ligne, 6).Value = "destruction"
        ElseIf Cells(ligne, 3) Like "*" & "2002" & "*" Then
            Cells(ligne, 6).Value = "destruction"
        ElseIf Cells(ligne, 3) Like "*" & "2003" & "*" Then
            Cells(ligne, 6).Value = "destruction"
        ElseIf Cells(ligne, 3) Like "*" & "2004" & "*" Then
            Cells(ligne, 6).Value = "destruction"
        ElseIf Cells(ligne, 3) Like "*" & "200501" & "*" Then
            Cells(ligne, 6).Value = "destruction"
        Else
            Cells(ligne, 6).Value = "conserver"
 
 
        End If
 
    Next
    Call traitement
End Sub
 
 
Sub traitement()
    Dim dl As Long
    dl = ActiveSheet.Range("a" & Rows.Count).End(xlUp).Row
    Dim i As Integer, i2 As Integer
    i = 2
    i2 = 3
    For i = 2 To dl
        While ActiveSheet.Range("a" & i) = ActiveSheet.Range("a" & i2)
 
            ActiveSheet.Range("f" & i & ":f" & i2).Select
            i2 = i2 + 1
 
        Wend
        If Application.WorksheetFunction.CountIf(Selection, "conserver") > 0 Then
            Selection = "conserver"
        End If
 
    Next
End Sub

**Oliv53** · 24/01/2015, 21h03

J'ai supprimé le contenu du champs F2:G33
j'ai copié le code proposé mais cela me donne aucune décision en F2:G33
cela sélectionne les cellules F32:F33 uniquement
J'avoue ne pas comprendre le code "traitement"

Après avoir recopié le code proposé sans supprimer le contenu du champs F2:G33 , effectivement cela fonctionne.
Mais inialement, le champs F2:G33 est vide.
Le champs F2:F33 se remplit en executant mon code RECH_UTIL2
et le champs G2:G33, je l'ai rempli manuellement pour faire voir ce que je souhaite comme résultat.

**casefayere** · 24/01/2015, 22h04

Bonsoir,
j'ai essayé de comprendre ton fichier, voici comment je traduis pour la colonne F

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
Sub RECH_UTIL2()
Dim ligne As Integer
Dim ref, x As Integer
ref = Array("1CN6", "1CS8", "1CU6", "1CV8", "1CX1", "1PN3")
For ligne = 2 To 33
  Cells(ligne, 6).Value = "conserver"
  If Cells(ligne, 2) = "" Then
    Cells(ligne, 6).Value = "analyse"
  End If
    ' liste des anciennes classes vehicule
  For x = 0 To UBound(ref)
    If Cells(ligne, 4) Like "*" & ref(x) & "*" Then
      Cells(ligne, 6).Value = "destruction"
    End If
  Next x
  'liste des années et mois à plus de 10 annees en date fin
  If Val(Cells(ligne, 5)) > 199 And Val(Cells(ligne, 5)) < 20050131 Then
    Cells(ligne, 6).Value = "destruction"
  End If
' liste des années et mois à plus de 10 annees en date debut
  If Val(Cells(ligne, 3)) > 198 And Val(Cells(ligne, 3)) < 20050131 Then
    Cells(ligne, 6).Value = "destruction"
  End If
Next ligne
End Sub

Pour la colonne G, si je ne me trompe pas, tu n'indiques nulle part quelles sont les conditions mais ce que j'ai fait pour la col F t'aidera peu-être

**(WOLF)** · 24/01/2015, 22h43

En pièce jointe, l'original de votre fichier (fonctionnel car testé plusieurs fois)

Votre macro et la mienne sont complémentaire, une fois que votre macro à terminé son traitement, la mienne prends le relai pour regrouper les décisions et dire : si dans tous les A il y a une fois conserver, alors indiquer sur toutes les lignes A " Conserver ". Et idem pour tous les groupes de référence de la colonne A.

Est-ce bien ceci que vous vouliez ?

P.S : vous n'avez pas à lancez manuellement ma macro, elle se lance automatiquement une fois que la votre à fini son traitement et avant de lancer macro, il faut d'abord effectuer un tri par ordre croissant (sur la colonne A si j'ai bien tout compris) comme vous l'aviez déjà fait pour le fichier de démonstration

Cordialement,

**Oliv53** · 24/01/2015, 23h17

Bonsoir casefayere, en réponse à ton message, je te remercie pour l'intérêt que tu portes à mon projet comme pour WOLF.
Ce que tu viens de me proposer est en effet une simplification de mon code c'est super, oui cela m'aidera.
Pour la colonne G, ce que je recherche, Wolf l'a bien compris, c'est la condition suivante :
Si l'article A (col.A) posséde un "conserver" en col.F alors toutes les lignes de cette article doivent renseigner "conserver"
comme l'exemple que je donne dans mon fichier que j'ai communiqué plus haut.

**Oliv53** · 24/01/2015, 23h31

Dans le fichier que tu m'as joint cela fonctionne très bien.

Mais, dans mon fichier démonstration :
Elle fonctionne si j'ai au préalable lancé la mienne.
C'est à dire : je copie ma macro, j'execute puis je remplace ma macro par la votre et j'obtiens le résultat recherché.
Mais lorsque je copie votre macro et que j'execute, cela sélectionne uniquement les 2 dernières cellules de la col.F.
c'est suprennant, Et d'après ce qui est écrit effectivement cela devrait fonctionner.

A la question : Est-ce bien ceci que vous vouliez ? OUI c'est bien ce que je veux.

Pour le tri croissant, ma démonstration est effectivement en ordre croissant mais dans la réalité les articles peuvent être dispercé.
S'il faut que je fasse un tri avant d'excuter la macro, ce n'est pas bloquant, je le ferai (c'est simple).

Je te remercie WOLF, après plusieurs jours de recherche et de naviguation sur la toile, tu m'as donné un bon coup de main.
milles fois merci.

**casefayere** · 24/01/2015, 23h33

D'après ce que tu dis, et sans vouloir interférer Wolf (je n'ai pu ouvrir son fichier), voici ce que ça donnerait

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
Sub RECH_UTIL2()
Dim ligne As Integer
Dim ref, x As Integer
ref = Array("1CN6", "1CS8", "1CU6", "1CV8", "1CX1", "1PN3")
For ligne = 2 To 33
  Cells(ligne, 6).Value = "conserver"
  If Cells(ligne, 2) = "" Then
    Cells(ligne, 6).Value = "analyse"
  End If
    ' liste des anciennes classes vehicule
  For x = 0 To UBound(ref)
    If Cells(ligne, 4) Like "*" & ref(x) & "*" Then
      Cells(ligne, 6).Value = "destruction"
    End If
  Next x
  'liste des années et mois à plus de 10 annees en date fin
  If Val(Cells(ligne, 5)) > 199 And Val(Cells(ligne, 5)) < 20050131 Then
    Cells(ligne, 6).Value = "destruction"
  End If
' liste des années et mois à plus de 10 annees en date debut
  If Val(Cells(ligne, 3)) > 198 And Val(Cells(ligne, 3)) < 20050131 Then
    Cells(ligne, 6).Value = "destruction"
  End If
  If Range("A" & ligne) = "A" And Range("F" & ligne) = "conserver" Then Range("G" & ligne) = "conserver"
  If Range("F" & ligne) = "conserver" Then Range("G" & ligne) = "conserver"
Next ligne
End Sub

**Oliv53** · 25/01/2015, 00h01

C'est bien cela, la décision de conservé est bien présente, ce qu'il faudrait maintenant pour compléter c'est avoir la cellule suivante renseigné comme ceci :
G2 = conserver ; G8 = analyser ; G15 = conserver ; G25 = destruction ; G32 = destruction
afin que je puisse identifier la liste des articles pour ces 3 décisions.

Je tiens à vous remercier tous les 2, à plusieurs on arrive à des résultats surprenants.

**casefayere** · 25/01/2015, 00h09

voilà mon code revu et amélioré (si tu ajoutes des lignes) mais je suis sur qu'il ne correspond pas encore à ta demande
pourquoi "G15 = conserver " ?
Nom : g15.JPG
Affichages : 88
Taille : 49,8 Ko

Nom : g15.JPG
Affichages : 88
Taille : 49,8 Ko

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
Sub RECH_UTIL2()
Dim ref, x As Integer
Dim Dc As Range, Plg As Range, Cel As Range
 
ref = Array("1CN6", "1CS8", "1CU6", "1CV8", "1CX1", "1PN3")
With Sheets("01")
  Set Dc = .Range("A" & .Rows.Count).End(xlUp)
  Set Plg = .Range("A2", Dc)
 
  For Each Cel In Plg
    Cel(1, 6) = "conserver"
    If Cel(1, 2) = "" Then
      Cel(1, 6).Value = "analyser"
    End If
    ' liste des anciennes classes vehicule
    For x = 0 To UBound(ref)
      If Cel(1, 4) Like "*" & ref(x) & "*" Then
        Cel(1, 6).Value = "destruction"
      End If
    Next x
    'liste des années et mois à plus de 10 annees en date fin
    If Val(Cel(1, 5)) > 199 And Val(Cel(1, 5)) < 20050131 Then
      Cel(1, 6).Value = "destruction"
    End If
    ' liste des années et mois à plus de 10 annees en date debut
    If Val(Cel(1, 3)) > 198 And Val(Cel(1, 3)) < 20050131 Then
      Cel(1, 6).Value = "destruction"
    End If
    Cel(1, 7) = Cel(1, 6)
    If Cel(1, 1) = "A" Or Cel(1, 6) = "conserver" Then Cel(1, 7) = "conserver"
  Next Cel
End With
End Sub

**(WOLF)** · 25/01/2015, 09h28

Bonjour oliv53, casefayere.

Oliv53, ma macro et la votre était complémentaire, votre macro appliquait une décision selon des conditions spécifiques et la mienne regroupait les décisions pour obtenir le résultat escompter. Sans votre macro, la mienne n'était évidement pas fonctionnelle car elle travaillait essentiellement avec les résultats obtenu en colonne F (par votre macro). Ceci dit, casefayere étant en train de revoir votre macro, tout ceci n'a plus lieu d'être.

casefayere, je ne vois pas votre intervention comme une interférence car au contraire, elle me donne l'occasion d'apprendre ce que je ne sais pas encore.

Cordialement,

**Oliv53** · 25/01/2015, 09h52

Bonjour casefayere,
Pourquoi G15 = conservé? Parce qu'en ligne 21 (F21)il existe un "conservé" pour l'article G.
Donc il devrait y avoir "conservé" sur tout le champs G15:G24, ce qui correspond uniquement à l'article G.
De même pour l'article B, étant donné qu'il existe 2 "conservé" en champs F4:F7 alors il devrait y avoir "conservé" sur tout le champs G4:G7.

La décision "conservé" est prioritaire.

**(WOLF)** · 25/01/2015, 09h58

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
Sub RECH_UTIL2()
    Dim ref, x As Integer
    Dim Dc As Range, Plg As Range, Cel As Range
 
    ref = Array("1CN6", "1CS8", "1CU6", "1CV8", "1CX1", "1PN3")
    With Sheets("01")
        Set Dc = .Range("A" & .Rows.Count).End(xlUp)
        Set Plg = .Range("A2", Dc)
 
        For Each Cel In Plg
            Cel(1, 6) = "conserver"
            If Cel(1, 2) = "" Then
                Cel(1, 6).Value = "analyser"
            End If
            ' liste des anciennes classes vehicule
            For x = 0 To UBound(ref)
                If Cel(1, 4) Like "*" & ref(x) & "*" Then
                    Cel(1, 6).Value = "destruction"
                End If
            Next x
            'liste des années et mois à plus de 10 annees en date fin
            If Val(Cel(1, 5)) > 199 And Val(Cel(1, 5)) < 20050131 Then
                Cel(1, 6).Value = "destruction"
            End If
            ' liste des années et mois à plus de 10 annees en date debut
            If Val(Cel(1, 3)) > 198 And Val(Cel(1, 3)) < 20050131 Then
                Cel(1, 6).Value = "destruction"
            End If
 
        Next Cel
        Call traitement
    End With
End Sub
 
Sub traitement()
    Dim dl As Long
    dl = Sheets("01").Range("a" & Rows.Count).End(xlUp).Row
    Dim i As Integer, i2 As Integer
    i = 2
    i2 = 3
    For i = 2 To dl
        While Sheets("01").Range("a" & i) = Sheets("01").Range("a" & i2)
 
            Sheets("01").Range("f" & i & ":f" & i2).Select
            i2 = i2 + 1
 
        Wend
        If Application.WorksheetFunction.CountIf(Selection, "conserver") > 0 Then
            Selection = "conserver"
        End If
 
    Next
End Sub

Ci-dessus, le code de casefayere dans son intégralité (sauf deux lignes) combiné avec le mien.
On est vraiment très proche du résultat escompter.

Copiez et collez toutes cette procédure dans votre fichier en remplacement du votre

.

casefayere, les deux lignes que j'ai supprimé sont celles qui font référence à la colonne G qui d'ordinaire n'existe pas car ce n'était q'une colonne de démonstration du résultat attendu.

Cordialement,