XL 2013 Limite de filtration via un dictionnaire

[Robidic]

Bonjour
Comme on ne peut pas exclure plusieurs valeurs par un autofiltre j utilise un dictionnaire pour en exclure certaines valeurs sauf que je me suis rendu compte que mon code fonctionne sur une quantité de ligne et je ne comprend pas pourquoi...
Au delà de 2000 lignes mon code n exclus lus les valeurs que je veux...
Merci de votre aide
Voici mon code:

    Dim d As Object, c As Range, x, i As Long, ws As Worksheet
    Dim tmp As String
  
    'pour supprimer le Dictionnaire de la mémoire
    Set d = Nothing
  
    Set ws = ActiveSheet
    Set d = CreateObject("scripting.dictionary")
    x = Application.Transpose(Range("J1", Cells(Rows.Count, "J").End(xlUp)))

    For i = 1 To UBound(x, 1)
        d(x(i)) = 1
    Next

    For Each c In ws.Range("J2", Cells(Rows.Count, "J").End(xlUp))
  
        tmp = c.Value
             
        If d.Exists(tmp) And (tmp) = "COK" Then d.Remove (tmp) 'élimine COK
        If d.Exists(tmp) And (tmp) = "RSA" Then d.Remove (tmp) 'élimine RSA
        If d.Exists(tmp) And (tmp) = "CIN" Then d.Remove (tmp) 'élimine CIN
        If d.Exists(tmp) And (tmp) = "AAN" Then d.Remove (tmp) 'élimine AAN
        If d.Exists(tmp) And (tmp) = "SSC" Then d.Remove (tmp) 'élimine SSC
        If d.Exists(tmp) And (tmp) = "CNA" Then d.Remove (tmp) 'élimine CNA

    Next
  
    With ws.Cells(1, 1).CurrentRegion
        .AutoFilter 10, Array(d.Keys), 7
    End With

 

[vgendron]

Bonjour

sans ton fichier, impossible de voir ce qui cloche...
et globalement, tu travailles à l'envers..
tu commences par faire un set d=nothing ==> cette instruction se met généralement en FIN de macro pour libérer la mémoire

ensuite, une première boucle pour créer toutes les valeurs
puis une deuxième boucle pour en supprimer certaines==> pourquoi ne pas créer les valeurs QUE SI elles sont autorisées??

 

[Robidic]

Je me suis inspiré de ce code...qui fonctionne très bien comme je le disais mais au delà de 2000 lignes environ il n exclus plus ce que je lui demande ou plutôt à moitié..

Option Explicit
Sub Exclude_3()
    Dim d As Object, c As Range, tmp As String, x, i As Long, ws As Worksheet
    Set ws = ActiveSheet
    Set d = CreateObject("scripting.dictionary")
    x = Application.Transpose(Range("J2", Cells(Rows.Count, "J").End(xlUp)))
    
    For i = 1 To UBound(x, 1)
        d(x(i)) = 1
    Next

    For Each c In ws.Range("J2", Cells(Rows.Count, "J").End(xlUp)) '<< change Column/Range to suit
        tmp = c.Value
        If d.exists(tmp) And (tmp) = "1" Then d.Remove (tmp) '<< removes 1
        If d.exists(tmp) And (tmp) = "5" Then d.Remove (tmp) '<< removes 5
    Next
    
    With ws.Cells(1, 1).CurrentRegion
        .AutoFilter 10, Array(d.keys), 7
    End With
End Sub

Avant:

Après:

 

[Deadpool_CC]

Bonjour,

Tu peux nous mettre le fichier plutôt que des images ?

 

[vgendron]

en attendant le fichier, il y a aussi la suppression de doublons intégrée à Excel..

 

[Deadpool_CC]

Salut @vgendron ... j'y avais pensé mais j'attends le fichier car dans ces images les lignes semblent masquées par un filtrage et non supprimées ...

 

[Robidic]

En KDO un ptit fichier d amusement

 

[Robidic]

si vous faites le test vous verrez ça dans le filtre

 

[Robidic]

on voit que SSC et CNA ne sont pas exclus du filtre.... Pourquoi ? Par contre si je diminue en ligne moins de 2000 à la louche toutes les exclusions fonctionnent....

 

[vgendron]

en retour une macro

Sub exclure()

With ActiveSheet
    .AutoFilterMode = False
    fin = .UsedRange.Rows.Count
    Set dico = CreateObject("scripting.dictionary")
    For i = 2 To fin
        tmp = .Range("J" & i)
        If Not dico.exists(tmp) And Trim(UCase(tmp)) <> "COK" And Trim(UCase(tmp)) <> "RSA" And Trim(UCase(tmp)) <> "CIN" And Trim(UCase(tmp)) <> "AAN" And Trim(UCase(tmp)) <> "SSC" And Trim(UCase(tmp)) <> "CNA" Then
            dico.Add tmp, tmp
        End If
    Next i
    '.Range("L3").Resize(dico.Count) = Application.Transpose(dico.keys) 'pour voir le résultat des exclusions
    .UsedRange.AutoFilter 10, Array(dico.keys), 7
End With
Set dico = Nothing
End Sub

ton problème vient des espaces et/ou minuscules

 

[dysorthographie]

Bonjour,
le filtre fait le distinguo entre minuscule et majuscule!

Sub Filtre()
With CreateObject("Adodb.connection")
    .Open = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=YES;"""
    With .Execute("select Distinct ucase([header10] ) FROM [ws$] WHERE ucase([header10]) not in('COK','RSA','CIN','AAN','SSC','CNA')")
        If Not .EOF Then
              Sheets("ws").Cells(1, 1).CurrentRegion.AutoFilter 10, .getrows, 7 
        End If '
        .Close
    End With
    .Close

End With
End Sub

 

[Deadpool_CC]

Bonjour,
Vérifie tes données (MAJ/minscule ; espace en trop ; lettre manquante)

 

[Robidic]

en retour une macro

Sub exclure()

With ActiveSheet
    .AutoFilterMode = False
    fin = .UsedRange.Rows.Count
    Set dico = CreateObject("scripting.dictionary")
    For i = 2 To fin
        tmp = .Range("J" & i)
        If Not dico.exists(tmp) And Trim(UCase(tmp)) <> "COK" And Trim(UCase(tmp)) <> "RSA" And Trim(UCase(tmp)) <> "CIN" And Trim(UCase(tmp)) <> "AAN" And Trim(UCase(tmp)) <> "SSC" And Trim(UCase(tmp)) <> "CNA" Then
            dico.Add tmp, tmp
        End If
    Next i
    '.Range("L3").Resize(dico.Count) = Application.Transpose(dico.keys) 'pour voir le résultat des exclusions
    .UsedRange.AutoFilter 10, Array(dico.keys), 7
End With
Set dico = Nothing
End Sub

ton problème vient des espaces et/ou minuscules

Super! Merci maintenant je comprend pourquoi ce blocage....

 

[Robidic]

Bonjour,
le filtre fait le distinguo entre minuscule et majuscule!

Sub Filtre()
With CreateObject("Adodb.connection")
    .Open = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=YES;"""
    With .Execute("select Distinct ucase([header10] ) FROM [ws$] WHERE ucase([header10]) not in('COK','RSA','CIN','AAN','SSC','CNA')")
        If Not .EOF Then
              Sheets("ws").Cells(1, 1).CurrentRegion.AutoFilter 10, .getrows, 7
        End If '
        .Close
    End With
    .Close

End With
End Sub

Merci de ton aide , mais je ne comprend pas trop ton code....c est pour que le filtre ne fasse pas de différence entre Majuscule et Minuscule ? si tu as 5 mn pour m éclairer...et c est à placer où ? ça peut servir pour d autre situation.

 

[dysorthographie]

Bonjour,
En fait le filtre fait la différence entre minuscule et majuscules, c'est l'objet qui collecte les données comme le dictionarry qui fait la différence !

Moi je fais une requête SQL pour sélectionner que ce qui m'intéresse dans ton tableau excel!

Je sélectionne la colonne portant le nom header10 en écartant in('COK','RSA','CIN','AAN','SSC','CNA')

Et je récupère le résultat sous forme de Array .getrows