XL 2013 Limite de filtration via un dictionnaire

Robidic · 22 Août 2022

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:

VB:

    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 · 22 Août 2022

en retour une macro

VB:

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

vgendron · 22 Août 2022

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 · 22 Août 2022

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é..

VB:

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 · 22 Août 2022

Bonjour,

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

vgendron · 22 Août 2022

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

Deadpool_CC · 22 Août 2022

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 · 22 Août 2022

En KDO un ptit fichier d amusement

Robidic · 22 Août 2022

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

Robidic · 22 Août 2022

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 · 22 Août 2022

en retour une macro

VB:

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 · 22 Août 2022

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

VB:

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 · 22 Août 2022

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

Robidic · 23 Août 2022

vgendron à dit:

en retour une macro

VB:

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 · 23 Août 2022

dysorthographie à dit:

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

VB:

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 · 23 Août 2022

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

XL 2013 Limite de filtration via un dictionnaire

Robidic

XLDnaute Nouveau

vgendron

vgendron

XLDnaute Barbatruc

Robidic

XLDnaute Nouveau

Deadpool_CC

XLDnaute Accro

vgendron

XLDnaute Barbatruc

Deadpool_CC

XLDnaute Accro

Robidic

XLDnaute Nouveau

Pièces jointes

Robidic

XLDnaute Nouveau

Robidic

XLDnaute Nouveau

vgendron

XLDnaute Barbatruc

dysorthographie

XLDnaute Accro

Deadpool_CC

XLDnaute Accro

Robidic

XLDnaute Nouveau

Robidic

XLDnaute Nouveau

dysorthographie

XLDnaute Accro

Discussions similaires