XL 2010 Modification de code pour y intéger une condition

Fils de Coulson · 4 Juin 2019

Bonjour à tous,
J'ai une macro qui sert à extraire des données sans doublons d'une feuille sur une autre :

VB:

Sub SansDoublonsTrie_SAP()
Dim MonDico As Object
Dim c As Range

Set MonDico = CreateObject("Scripting.Dictionary")
With Worksheets("Rapport 1")
     For Each c In .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
         If Not MonDico.exists(Trim(c.Value)) Then MonDico.Add Trim(c.Value), Trim(c.Value)
     Next c
     With Sheets("Activités terminées").Range("A3").Resize(MonDico.Count, 1)
         .Value = Application.Transpose(MonDico.keys)
         .Sort Key1:=Worksheets("Activités terminées").Range("A3"), Order1:=xlAscending, Header:=xlNo
     End With
End With
Set MonDico = Nothing
End Sub

auquel j'aimerais rajouter une condition.
La condition est la suivante : si la plage nommée "Etat_de_l_activité" est égal à 2.

Merci par avance de bien vouloir m'aiguiller.
Bonne journée.

job75 · 4 Juin 2019

Bonjour Fils de Coulson, le forum,

Mettre au début de la macro :

VB:

If [Etat_de_l_activité] <> 2 Then Exit Sub

Bonne journée.

Fils de Coulson · 4 Juin 2019

Bonjour job75,
Merci pour ta réponse.
J'ai suivi ta procédure mais j'ai une erreur d’exécution 13 : incompatibilité de type.
Merci pour ton retour.

job75 · 4 Juin 2019

Bah il faut que le nom "Etat_de_l_activité" existe :

VB:

If IsError([Etat_de_l_activité]) Then Exit Sub
If [Etat_de_l_activité] <> 2 Then Exit Sub

job75 · 4 Juin 2019

Et bien sûr la plage nommée doit être constituée d'une seule cellule, le message d'erreur vous réveillera dans le cas contraire.

Fils de Coulson · 4 Juin 2019

Cela doit être pour cela que cela ne fonctionne pas : la plage nommée n'est pas constituée d'une seule cellule mais de plusieurs cellules d'une colonne (plage nommée dynamique).

job75 · 4 Juin 2019

Alors qu'est-ce qui doit être égal à 2 ? La 1ère cellule ou toutes les cellules ?

Si c'est la 1ère cellule utilisez :

VB:

If TypeName([Etat_de_l_activité]) <> "Range" Then Exit Sub
If CStr([Etat_de_l_activité].Cells(1)) <> "2" Then Exit Sub

Fils de Coulson · 4 Juin 2019

Toutes les cellules de la plage : désolé de ne pas avoir été plus précis dans ma demande initiale.

job75 · 4 Juin 2019

Fils de Coulson à dit:
Toutes les cellules de la plage

On y arrive enfin :

VB:

If TypeName([Etat_de_l_activité]) <> "Range" Then Exit Sub
If Application.CountIf([Etat_de_l_activité], 2) <> [Etat_de_l_activité].Count Then Exit Sub

Fils de Coulson · 4 Juin 2019

Merci pour ta patience.
Je teste et je te redis.
Bonne journée en attendant.

Fils de Coulson · 6 Juin 2019

Bonjour job75, le forum,
Désolé pour cette réponse tardive.
Même en rajoutant tes lignes de codes, je n'arrive pas à obtenir ce que je souhaite.
Je vais essayer d'anonymiser mes données et posté un fichier : je pense que ce sera plus parlant.
Merci en attendant. Bonne journée.

Fils de Coulson · 11 Juin 2019

Bonjour job75, le forum,
Voici le fichier anonymisé avec la macro d'origine.
Je voudrais que les lignes surlignées en rouge dans l'onglet "Activités terminées" soient exclues de l'extraction afin de ne garder que les données dont les activités sont au statut "2" (colonne L dans l'onglet "Rapport 1").
Voilà, en espérant avoir été plus explicite.
Merci par avance et bonne journée.

job75 · 11 Juin 2019

Bonjour Fils de Coulson,

Avec le fichier le problème aurait été réglé immédiatement il y a une semaine :

VB:

Sub SansDoublonsTrie_SAP()
Dim MonDico As Object, c As Range
Set MonDico = CreateObject("Scripting.Dictionary")
With Worksheets("Rapport 1")
     For Each c In .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
         If c(1, 12) = 2 Then MonDico(Trim(c.Value)) = ""
     Next c
End With
With Sheets("Activités terminées").Range("A3")
    If MonDico.Count Then
        With .Resize(MonDico.Count)
            .Value = Application.Transpose(MonDico.keys)
            .Sort Key1:=.Columns(1), Order1:=xlAscending, Header:=xlNo
        End With
    End If
    .Offset(MonDico.Count).Resize(Rows.Count - MonDico.Count - .Row + 1).ClearContents 'RAZ en dessous
End With
End Sub

A+

Fils de Coulson · 11 Juin 2019

Re,
J'en suis bien conscient et je m'en excuse encore une fois.
Merci pour ton retour en attendant.
Je teste et te redis.
Bon après-midi.

Fils de Coulson · 12 Juin 2019

Bonjour job75, le forum,
Encore un grand merci : j'arrive bien au résultat voulu.
Bonne continuation et bonne journée.

XL 2010 Modification de code pour y intéger une condition

Fils de Coulson

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Fils de Coulson

XLDnaute Nouveau

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Fils de Coulson

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Fils de Coulson

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Fils de Coulson

XLDnaute Nouveau

Fils de Coulson

XLDnaute Nouveau

Fils de Coulson

XLDnaute Nouveau

Pièces jointes

job75

XLDnaute Barbatruc

Fils de Coulson

XLDnaute Nouveau

Fils de Coulson

XLDnaute Nouveau

Discussions similaires