XL 2013 Limite de filtration via un dictionnaire

Robidic

XLDnaute Nouveau
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...:confused:
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
 
Dernière édition:
Solution
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

XLDnaute Barbatruc
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

XLDnaute Nouveau
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:
filtre1.jpg

Après:
filtre2.jpg
 

vgendron

XLDnaute Barbatruc
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

XLDnaute Accro
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
 

Robidic

XLDnaute Nouveau
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

XLDnaute Nouveau
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

XLDnaute Accro
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
 

Discussions similaires

Réponses
1
Affichages
204
Réponses
1
Affichages
119

Statistiques des forums

Discussions
311 710
Messages
2 081 781
Membres
101 817
dernier inscrit
carvajal